Mac-Source 1994 July

home *** CD-ROM | disk | FTP | other *** search

/ Mac-Source 1994 July / Mac-Source_July_1994.iso / C and C++ / Science⁄Math / meschach / meschach0.shar < prev next >

Wrap

Text File | 1994-06-07 | 393.1 KB | 13,827 lines | [TEXT/ttxt]

# to unbundle, sh this file (in an empty directory) echo dmacheps.c 1>&2 sed >dmacheps.c <<'//GO.SYSIN DD dmacheps.c' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -#include <stdio.h> - -double dclean(x) -double x; -{ - static double y; - y = x; - return y; /* prevents optimisation */ -} - -main() -{ - static double deps, deps1, dtmp; - - deps = 1.0; - while ( dclean(1.0+deps) > 1.0 ) - deps = 0.5*deps; - - printf("%g\n", 2.0*deps); -} //GO.SYSIN DD dmacheps.c echo extras.c 1>&2 sed >extras.c <<'//GO.SYSIN DD extras.c' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -/* - Memory port routines: MEM_COPY and MEM_ZERO -*/ - -/* For BSD 4.[23] environments: using bcopy() and bzero() */ - -#include "machine.h" - -#ifndef MEM_COPY -void MEM_COPY(from,to,len) -char *from, *to; -int len; -{ - int i; - - if ( from < to ) - { - for ( i = 0; i < len; i++ ) - *to++ = *from++; - } - else - { - from += len; to += len; - for ( i = 0; i < len; i++ ) - *(--to) = *(--from); - } -} -#endif - -#ifndef MEM_ZERO -void MEM_ZERO(ptr,len) -char *ptr; -int len; -{ - int i; - - for ( i = 0; i < len; i++ ) - *(ptr++) = '\0'; -} -#endif - -/* - This file contains versions of something approximating the well-known - BLAS routines in C, suitable for Meschach (hence the `m'). - These are "vanilla" implementations, at least with some consideration - of the effects of caching and paging, and maybe some loop unrolling - for register-rich machines -*/ - -/* - Organisation of matrices: it is assumed that matrices are represented - by Real **'s. To keep flexibility, there is also an "initial - column" parameter j0, so that the actual elements used are - A[0][j0], A[0][j0+1], ..., A[0][j0+n-1] - A[1][j0], A[1][j0+1], ..., A[1][j0+n-1] - .. .. ... .. - A[m-1][j0], A[m-1][j0+1], ..., A[m-1][j0+n-1] -*/ - -static char rcsid[] = "$Id: extras.c,v 1.3 1994/01/13 05:45:36 des Exp $"; - -#include <math.h> - -#define REGISTER_RICH 1 - -/* mblar-1 routines */ - -/* Mscale -- sets x <- alpha.x */ -void Mscale(len,alpha,x) -int len; -double alpha; -Real *x; -{ - register int i; - - for ( i = 0; i < len; i++ ) - x[i] *= alpha; -} - -/* Mswap -- swaps x and y */ -void Mswap(len,x,y) -int len; -Real *x, *y; -{ - register int i; - register Real tmp; - - for ( i = 0; i < len; i++ ) - { - tmp = x[i]; - x[i] = y[i]; - y[i] = tmp; - } -} - -/* Mcopy -- copies x to y */ -void Mcopy(len,x,y) -int len; -Real *x, *y; -{ - register int i; - - for ( i = 0; i < len; i++ ) - y[i] = x[i]; -} - -/* Maxpy -- y <- y + alpha.x */ -void Maxpy(len,alpha,x,y) -int len; -double alpha; -Real *x, *y; -{ - register int i, len4; - - /**************************************** - for ( i = 0; i < len; i++ ) - y[i] += alpha*x[i]; - ****************************************/ - -#ifdef REGISTER_RICH - len4 = len / 4; - len = len % 4; - for ( i = 0; i < len4; i++ ) - { - y[4*i] += alpha*x[4*i]; - y[4*i+1] += alpha*x[4*i+1]; - y[4*i+2] += alpha*x[4*i+2]; - y[4*i+3] += alpha*x[4*i+3]; - } - x += 4*len4; y += 4*len4; -#endif - for ( i = 0; i < len; i++ ) - y[i] += alpha*x[i]; -} - -/* Mdot -- returns x'.y */ -double Mdot(len,x,y) -int len; -Real *x, *y; -{ - register int i, len4; - register Real sum; - -#ifndef REGISTER_RICH - sum = 0.0; -#endif - -#ifdef REGISTER_RICH - register Real sum0, sum1, sum2, sum3; - - sum0 = sum1 = sum2 = sum3 = 0.0; - - len4 = len / 4; - len = len % 4; - - for ( i = 0; i < len4; i++ ) - { - sum0 += x[4*i ]*y[4*i ]; - sum1 += x[4*i+1]*y[4*i+1]; - sum2 += x[4*i+2]*y[4*i+2]; - sum3 += x[4*i+3]*y[4*i+3]; - } - sum = sum0 + sum1 + sum2 + sum3; - x += 4*len4; y += 4*len4; -#endif - - for ( i = 0; i < len; i++ ) - sum += x[i]*y[i]; - - return sum; -} - -#ifndef ABS -#define ABS(x) ((x) >= 0 ? (x) : -(x)) -#endif - -/* Mnorminf -- returns ||x||_inf */ -double Mnorminf(len,x) -int len; -Real *x; -{ - register int i; - register Real tmp, max_val; - - max_val = 0.0; - for ( i = 0; i < len; i++ ) - { - tmp = ABS(x[i]); - if ( max_val < tmp ) - max_val = tmp; - } - - return max_val; -} - -/* Mnorm1 -- returns ||x||_1 */ -double Mnorm1(len,x) -int len; -Real *x; -{ - register int i; - register Real sum; - - sum = 0.0; - for ( i = 0; i < len; i++ ) - sum += ABS(x[i]); - - return sum; -} - -/* Mnorm2 -- returns ||x||_2 */ -double Mnorm2(len,x) -int len; -Real *x; -{ - register int i; - register Real norm, invnorm, sum, tmp; - - norm = Mnorminf(len,x); - if ( norm == 0.0 ) - return 0.0; - invnorm = 1.0/norm; - sum = 0.0; - for ( i = 0; i < len; i++ ) - { - tmp = x[i]*invnorm; - sum += tmp*tmp; - } - - return sum/invnorm; -} - -/* mblar-2 routines */ - -/* Mmv -- y <- alpha.A.x + beta.y */ -void Mmv(m,n,alpha,A,j0,x,beta,y) -int m, n, j0; -double alpha, beta; -Real **A, *x, *y; -{ - register int i, j, m4, n4; - register Real sum0, sum1, sum2, sum3, tmp0, tmp1, tmp2, tmp3; - register Real *dp0, *dp1, *dp2, *dp3; - - /**************************************** - for ( i = 0; i < m; i++ ) - y[i] += alpha*Mdot(n,&(A[i][j0]),x); - ****************************************/ - - m4 = n4 = 0; - -#ifdef REGISTER_RICH - m4 = m / 4; - m = m % 4; - n4 = n / 4; - n = n % 4; - - for ( i = 0; i < m4; i++ ) - { - sum0 = sum1 = sum2 = sum3 = 0.0; - dp0 = &(A[4*i ][j0]); - dp1 = &(A[4*i+1][j0]); - dp2 = &(A[4*i+2][j0]); - dp3 = &(A[4*i+3][j0]); - - for ( j = 0; j < n4; j++ ) - { - tmp0 = x[4*j ]; - tmp1 = x[4*j+1]; - tmp2 = x[4*j+2]; - tmp3 = x[4*j+3]; - sum0 = sum0 + dp0[j]*tmp0 + dp0[j+1]*tmp1 + - dp0[j+2]*tmp2 + dp0[j+3]*tmp3; - sum1 = sum1 + dp1[j]*tmp0 + dp1[j+1]*tmp1 + - dp1[j+2]*tmp2 + dp1[j+3]*tmp3; - sum2 = sum2 + dp2[j]*tmp0 + dp2[j+1]*tmp1 + - dp2[j+2]*tmp2 + dp2[j+3]*tmp3; - sum3 = sum3 + dp3[j]*tmp0 + dp3[j+1]*tmp2 + - dp3[j+2]*tmp2 + dp3[j+3]*tmp3; - } - for ( j = 0; j < n; j++ ) - { - sum0 += dp0[4*n4+j]*x[4*n4+j]; - sum1 += dp1[4*n4+j]*x[4*n4+j]; - sum2 += dp2[4*n4+j]*x[4*n4+j]; - sum3 += dp3[4*n4+j]*x[4*n4+j]; - } - y[4*i ] = beta*y[4*i ] + alpha*sum0; - y[4*i+1] = beta*y[4*i+1] + alpha*sum1; - y[4*i+2] = beta*y[4*i+2] + alpha*sum2; - y[4*i+3] = beta*y[4*i+3] + alpha*sum3; - } -#endif - - for ( i = 0; i < m; i++ ) - y[4*m4+i] = beta*y[i] + alpha*Mdot(4*n4+n,&(A[4*m4+i][j0]),x); -} - -/* Mvm -- y <- alpha.A^T.x + beta.y */ -void Mvm(m,n,alpha,A,j0,x,beta,y) -int m, n, j0; -double alpha, beta; -Real **A, *x, *y; -{ - register int i, j, m4, n2; - register Real *Aref; - register Real tmp; - -#ifdef REGISTER_RICH - register Real *Aref0, *Aref1; - register Real tmp0, tmp1; - register Real yval0, yval1, yval2, yval3; -#endif - - if ( beta != 1.0 ) - Mscale(m,beta,y); - /**************************************** - for ( j = 0; j < n; j++ ) - Maxpy(m,alpha*x[j],&(A[j][j0]),y); - ****************************************/ - m4 = n2 = 0; - - m4 = m / 4; - m = m % 4; -#ifdef REGISTER_RICH - n2 = n / 2; - n = n % 2; - - for ( j = 0; j < n2; j++ ) - { - tmp0 = alpha*x[2*j]; - tmp1 = alpha*x[2*j+1]; - Aref0 = &(A[2*j ][j0]); - Aref1 = &(A[2*j+1][j0]); - for ( i = 0; i < m4; i++ ) - { - yval0 = y[4*i ] + tmp0*Aref0[4*i ]; - yval1 = y[4*i+1] + tmp0*Aref0[4*i+1]; - yval2 = y[4*i+2] + tmp0*Aref0[4*i+2]; - yval3 = y[4*i+3] + tmp0*Aref0[4*i+3]; - y[4*i ] = yval0 + tmp1*Aref1[4*i ]; - y[4*i+1] = yval1 + tmp1*Aref1[4*i+1]; - y[4*i+2] = yval2 + tmp1*Aref1[4*i+2]; - y[4*i+3] = yval3 + tmp1*Aref1[4*i+3]; - } - y += 4*m4; Aref0 += 4*m4; Aref1 += 4*m4; - for ( i = 0; i < m; i++ ) - y[i] += tmp0*Aref0[i] + tmp1*Aref1[i]; - } -#endif - - for ( j = 0; j < n; j++ ) - { - tmp = alpha*x[2*n2+j]; - Aref = &(A[2*n2+j][j0]); - for ( i = 0; i < m4; i++ ) - { - y[4*i ] += tmp*Aref[4*i ]; - y[4*i+1] += tmp*Aref[4*i+1]; - y[4*i+2] += tmp*Aref[4*i+2]; - y[4*i+3] += tmp*Aref[4*i+3]; - } - y += 4*m4; Aref += 4*m4; - for ( i = 0; i < m; i++ ) - y[i] += tmp*Aref[i]; - } -} - -/* Mupdate -- A <- A + alpha.x.y^T */ -void Mupdate(m,n,alpha,x,y,A,j0) -int m, n, j0; -double alpha; -Real **A, *x, *y; -{ - register int i, j, n4; - register Real *Aref; - register Real tmp; - - /**************************************** - for ( i = 0; i < m; i++ ) - Maxpy(n,alpha*x[i],y,&(A[i][j0])); - ****************************************/ - - n4 = n / 4; - n = n % 4; - for ( i = 0; i < m; i++ ) - { - tmp = alpha*x[i]; - Aref = &(A[i][j0]); - for ( j = 0; j < n4; j++ ) - { - Aref[4*j ] += tmp*y[4*j ]; - Aref[4*j+1] += tmp*y[4*j+1]; - Aref[4*j+2] += tmp*y[4*j+2]; - Aref[4*j+3] += tmp*y[4*j+3]; - } - Aref += 4*n4; y += 4*n4; - for ( j = 0; j < n; j++ ) - Aref[j] += tmp*y[j]; - } -} - -/* mblar-3 routines */ - -/* Mmm -- C <- C + alpha.A.B */ -void Mmm(m,n,p,alpha,A,Aj0,B,Bj0,C,Cj0) -int m, n, p; /* C is m x n */ -double alpha; -Real **A, **B, **C; -int Aj0, Bj0, Cj0; -{ - register int i, j, k; - /* register Real tmp, sum; */ - - /**************************************** - for ( i = 0; i < m; i++ ) - for ( k = 0; k < p; k++ ) - Maxpy(n,alpha*A[i][Aj0+k],&(B[k][Bj0]),&(C[i][Cj0])); - ****************************************/ - for ( i = 0; i < m; i++ ) - Mvm(p,n,alpha,&(A[i][Aj0]),B,Bj0,&(C[i][Cj0])); -} - -/* Mmtrm -- C <- C + alpha.A^T.B */ -void Mmtrm(m,n,p,alpha,A,Aj0,B,Bj0,C,Cj0) -int m, n, p; /* C is m x n */ -double alpha; -Real **A, **B, **C; -int Aj0, Bj0, Cj0; -{ - register int i, j, k; - - /**************************************** - for ( i = 0; i < m; i++ ) - for ( k = 0; k < p; k++ ) - Maxpy(n,alpha*A[k][Aj0+i],&(B[k][Bj0]),&(C[i][Cj0])); - ****************************************/ - for ( k = 0; k < p; k++ ) - Mupdate(m,n,alpha,&(A[k][Aj0]),&(B[k][Bj0]),C,Cj0); -} - -/* Mmmtr -- C <- C + alpha.A.B^T */ -void Mmmtr(m,n,p,alpha,A,Aj0,B,Bj0,C,Cj0) -int m, n, p; /* C is m x n */ -double alpha; -Real **A, **B, **C; -int Aj0, Bj0, Cj0; -{ - register int i, j, k; - - /**************************************** - for ( i = 0; i < m; i++ ) - for ( j = 0; j < n; j++ ) - C[i][Cj0+j] += alpha*Mdot(p,&(A[i][Aj0]),&(B[j][Bj0])); - ****************************************/ - for ( i = 0; i < m; i++ ) - Mmv(n,p,alpha,&(A[i][Aj0]),B,Bj0,&(C[i][Cj0])); -} - -/* Mmtrmtr -- C <- C + alpha.A^T.B^T */ -void Mmtrmtr(m,n,p,alpha,A,Aj0,B,Bj0,C,Cj0) -int m, n, p; /* C is m x n */ -double alpha; -Real **A, **B, **C; -int Aj0, Bj0, Cj0; -{ - register int i, j, k; - - for ( i = 0; i < m; i++ ) - for ( j = 0; j < n; j++ ) - for ( k = 0; k < p; k++ ) - C[i][Cj0+j] += A[i][Aj0+k]*B[k][Bj0+j]; -} - //GO.SYSIN DD extras.c echo fmacheps.c 1>&2 sed >fmacheps.c <<'//GO.SYSIN DD fmacheps.c' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -#include <stdio.h> - -double fclean(x) -double x; -{ - static float y; - y = x; - return y; /* prevents optimisation */ -} - -main() -{ - static float feps, feps1, ftmp; - - feps = 1.0; - while ( fclean(1.0+feps) > 1.0 ) - feps = 0.5*feps; - - printf("%g\n", 2.0*feps); -} //GO.SYSIN DD fmacheps.c echo maxint.c 1>&2 sed >maxint.c <<'//GO.SYSIN DD maxint.c' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -main() -{ - int i, old_i; - - i = 1; - while ( i > 0 ) - { - old_i = i; - i = (i << 1) | 1; - } - printf("%d\n", old_i); -} //GO.SYSIN DD maxint.c echo makefile.in 1>&2 sed >makefile.in <<'//GO.SYSIN DD makefile.in' 's/^-//' -# -# Makefile for Meschach via autoconf -# -# Copyright (C) David Stewart & Zbigniew Leyk 1993 -# -# $Id: makefile.in,v 1.4 1994/03/14 01:24:06 des Exp $ -# - -srcdir = @srcdir@ -VPATH = @srcdir@ - -CC = @CC@ - -DEFS = @DEFS@ -LIBS = @LIBS@ -RANLIB = @RANLIB@ - - -CFLAGS = -O - - -.c.o: - $(CC) -c $(CFLAGS) $(DEFS) $< - -SHELL = /bin/sh -MES_PAK = mesch12b -TAR = tar -SHAR = stree -u -ZIP = zip -r -l -FLIST = FILELIST - -############################### - -LIST1 = copy.o err.o matrixio.o memory.o vecop.o matop.o pxop.o \ - submat.o init.o otherio.o machine.o matlab.o ivecop.o version.o \ - meminfo.o memstat.o -LIST2 = lufactor.o bkpfacto.o chfactor.o qrfactor.o solve.o hsehldr.o \ - givens.o update.o norm.o hessen.o symmeig.o schur.o svd.o fft.o \ - mfunc.o bdfactor.o -LIST3 = sparse.o sprow.o sparseio.o spchfctr.o splufctr.o \ - spbkp.o spswap.o iter0.o itersym.o iternsym.o -ZLIST1 = zmachine.o zcopy.o zmatio.o zmemory.o zvecop.o zmatop.o znorm.o \ - zfunc.o -ZLIST2 = zlufctr.o zsolve.o zmatlab.o zhsehldr.o zqrfctr.o \ - zgivens.o zhessen.o zschur.o - -# they are no longer supported -# if you use them add oldpart to all and sparse -OLDLIST = conjgrad.o lanczos.o arnoldi.o - -ALL_LISTS = $(LIST1) $(LIST2) $(LIST3) $(ZLIST1) $(ZLIST2) $(OLDLIST) - -HBASE = err.h meminfo.h machine.h matrix.h - -HLIST = $(HBASE) iter.h matlab.h matrix2.h oldnames.h sparse.h \ - sparse2.h zmatrix.h zmatrix2.h - -TORTURE = torture.o sptort.o ztorture.o memtort.o itertort.o \ - mfuntort.o iotort.o - -OTHERS = dmacheps.c extras.c fmacheps.c maxint.c makefile.in \ - README configure configure.in machine.h.in copyright \ - tutorial.c tutadv.c rk4.dat ls.dat makefile $(FLIST) - - -# Different configurations -# the dependencies **between** the parts are for dmake -all: @PROGS@ part1 part2 part3 zpart1 zpart2 -part2: part1 -part3: part2 -basic: part1 part2 -sparse: part1 part2 part3 -zpart2: zpart1 -complex: part1 part2 zpart1 zpart2 - - -$(LIST1): $(HBASE) -part1: $(LIST1) - ar ru meschach.a $(LIST1); $(RANLIB) meschach.a - -$(LIST2): $(HBASE) matrix2.h -part2: $(LIST2) - ar ru meschach.a $(LIST2); $(RANLIB) meschach.a - -$(LIST3): $(HBASE) sparse.h sparse2.h -part3: $(LIST3) - ar ru meschach.a $(LIST3); $(RANLIB) meschach.a - -$(ZLIST1): $(HBASDE) zmatrix.h -zpart1: $(ZLIST1) - ar ru meschach.a $(ZLIST1); $(RANLIB) meschach.a - -$(ZLIST2): $(HBASE) zmatrix.h zmatrix2.h -zpart2: $(ZLIST2) - ar ru meschach.a $(ZLIST2); $(RANLIB) meschach.a - -$(OLDLIST): $(HBASE) sparse.h sparse2.h -oldpart: $(OLDLIST) - ar ru meschach.a $(OLDLIST); $(RANLIB) meschach.a - - - -####################################### - -tar: - - /bin/rm -f $(MES_PAK).tar - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(TAR) cvf $(MES_PAK).tar \ - `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) \ - `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC - -# use this only for PC machines -msdos-zip: - - /bin/rm -f $(MES_PAK).zip - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(ZIP) $(MES_PAK).zip \ - `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC - - -fullshar: - - /bin/rm -f $(MES_PAK).shar; - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(SHAR) `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC > $(MES_PAK).shar - -shar: - - /bin/rm -f meschach1.shar meschach2.shar meschach3.shar \ - meschach4.shar oldmeschach.shar meschach0.shar - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(SHAR) `echo $(LIST1) | sed -e 's/\.o/.c/g'` > meschach1.shar - $(SHAR) `echo $(LIST2) | sed -e 's/\.o/.c/g'` > meschach2.shar - $(SHAR) `echo $(LIST3) | sed -e 's/\.o/.c/g'` > meschach3.shar - $(SHAR) `echo $(ZLIST1) | sed -e 's/\.o/.c/g'` \ - `echo $(ZLIST2) | sed -e 's/\.o/.c/g'` > meschach4.shar - $(SHAR) `echo $(OLDLIST) | sed -e 's/\.o/.c/g'` > oldmeschach.shar - $(SHAR) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - $(HLIST) DOC MACHINES > meschach0.shar - -list: - /bin/rm -f $(FLIST) - ls -lR `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) MACHINES DOC \ - |awk '/^$$/ {print};/^[-d]/ {printf("%s %s %10d %s %s %s %s\n", \ - $$1,$$2,$$5,$$6,$$7,$$8,$$9)}; /^[^-d]/ {print}' \ - > $(FLIST) - - - -clean: - /bin/rm -f *.o core asx5213a.mat iotort.dat - -cleanup: - /bin/rm -f *.o core asx5213a.mat iotort.dat *.a - -realclean: - /bin/rm -f *.o core asx5213a.mat iotort.dat *.a - /bin/rm -f torture sptort ztorture memtort itertort mfuntort iotort - /bin/rm -f makefile machine.h config.status maxint macheps - -alltorture: torture sptort ztorture memtort itertort mfuntort iotort - -torture:torture.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o torture torture.o \ - meschach.a $(LIBS) -sptort:sptort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o sptort sptort.o \ - meschach.a $(LIBS) -memtort: memtort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o memtort memtort.o \ - meschach.a $(LIBS) -ztorture:ztorture.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o ztorture ztorture.o \ - meschach.a $(LIBS) -itertort: itertort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o itertort itertort.o \ - meschach.a $(LIBS) - -iotort: iotort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o iotort iotort.o \ - meschach.a $(LIBS) -mfuntort: mfuntort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o mfuntort mfuntort.o \ - meschach.a $(LIBS) -tstmove: tstmove.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o tstmove tstmove.o \ - meschach.a $(LIBS) -tstpxvec: tstpxvec.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o tstpxvec tstpxvec.o \ - meschach.a $(LIBS) - //GO.SYSIN DD makefile.in echo README 1>&2 sed >README <<'//GO.SYSIN DD README' 's/^-//' - - - - Meschach Library - Version 1.2b - - - David E. Stewart - (david.stewart@anu.edu.au) - - and - - Zbigniew Leyk - (zbigniew.leyk@anu.edu.au) - - School of Mathematical Sciences - Australian National University - Canberra ACT 0200 - Australia - - - [last revised: 6th April, 1994] - - - 1. INTRODUCTION - - The Meschach Library is a numerical library of C routines for performing -calculations on matrices and vectors. It is intended for solving systems of -linear equations (dense and sparse), solve least squares problems, -computing eigenvalues and eigenvectors, etc. We do not claim that it -contains every useful algorithm in numerical linear algebra, but it does -provide a basis on which more advanced algorithms can be built. The library -is for people who know something about the C programming language, -something of how to solve the numerical problem they are faced with but do -not want to have the hassle of building all the necessary routines from the -scratch. The library is not a loose collection of numerical routines but it -comprises a coherent system. The current version is enhanced with many -features comparing with previous versions. Since the memory requirements -are nontrivial for large problems we have paid more attention to -allocation/deallocation of memory. - - The source code is available to be perused, used and passed on without -cost, while ensuring that the quality of the software is not compromised. -The software is copyrighted; however, the copyright agreement follows in -the footsteps of the Free Software Foundation in preventing abuse that -occurs with totally public domain software. - - Detailed instructions for installing Meschach are contained below. - - Pronunciation: if in doubt, say "me-shark". This is close enough. -Don't ask us "Why call it that?" Have a look at the quote at the front of -the manual. - - - 2. AVAILABILITY - - The authors make this code openly available to others, in the hope that -it will prove to be a useful tool. We ask only that: - -* If you publish results obtained using Meschach, please consider - acknowledging the source of the code. - -* If you discover any errors in the code, please promptly communicate them - to the authors. - - We also suggest that you send email to the authors identifying yourself -as a user of Meschach; this will enable the authors to notify you of any -corrections/improvements in Meschach. - - - - 3. HOW TO GET IT - - There are several different forms in which you might receive Meschach. -To provide a shorthand for describing collections of files, the Unix -convention of putting alternative letters in [...] will be used. (So, -fred[123] means the collection fred1, fred2 and fred3.) Meschach is -available over Internet/AARnet via netlib, or at the anonymous ftp site -thrain.anu.edu.au in the directory pub/meschach. There are five .shar -files: meschach[01234].shar (which contain the library itself), -meschach0.shar (which contains basic documentation and machine dependent -files for a number of machines). Of the meschach[1234].shar files, only -meschach[12].shar are needed for the basic Meschach library; the third -.shar file contains the sparse matrix routines, and the the fourth contains -the routines for complex numbers, vectors and matrices. There is also a -README file that you should get from meschach0.shar. - - If you need the old iterative routines, the file oldmeschach.shar -contains the files conjgrad.c, arnoldi.c and lanczos.c. - - To get the library from netlib, - -mail netlib@research.att.com -send all from c/meschach - - There are a number of other netlib sites which mirror the main netlib -sites. These include netlib@ornl.gov (Oak Ridge, TN, USA), netlib@nac.no -(Oslo, Norway), ftp.cs.uow.edu.au (Wollongong, Australia; ftp only), -netlib@nchc.edu.tw (Taiwan), elib.zib-berlin.de (Berlin, Germany; ftp -only). (For anonymous ftp sites the directory containing the Meschach -.shar files is pub/netlib/c/meschach or similar, possibly depending on the -site.) - - Meschach is available in other forms on thrain.anu.edu.au by ftp in the -directory pub/meschach. It is available as a .tar file (mesch12a.tar for -version 1.2a), or as a collection of .shar files, or as a .zip file. The -.tar and .zip versions each contain the entire contents of the Meschach -library. - - There is a manual called "Meschach: Matrix Computations in C" which has -been published by - - Centre for Mathematics and its Applications - School of Mathematical Sciences - Australian National University - Canberra, ACT 0200 - Australia - -and costs A$30 (about US$22) + postage/handling. You can order it by -writing there or you can send email messages to one of us -(david.stewart@anu.edu.au or zbigniew.leyk@anu.edu.au) and we can pass it -on. - - If you don't have any money, as a stop gap you can get the **OLD** -manual, although it is out of date, by anonymous ftp from - - thrain.anu.edu.au : /pub/meschach/version1.1b/bookdvi.tar [.Z or .gz] - -In addition, don't forget that the distribution includes a DOC directory -which contains tutorial.txt and fnindex.txt which are respectively, the -tutorial chapter (text version) and the function index (text version). - - - - 4. INSTALLATION - - a) On Unix machines - - To extract the files from the .shar files, put them all into a suitable -directory and use - - sh <file>.shar - -to expand the files. (Use one sh command per file; sh *.shar will not work -in general.) - - For the .tar file, use - - tar xvf mesch12a.tar - -and for the .zip file use - - unzip mesch12a.zip - - On a Unix system you can use the configure script to set up the -machine-dependent files. The script takes a number of options which are -used for installing different subsets of the full Meschach. For the basic -system, which requires only meschach[012].shar, use - - configure - make basic - make clean - - For including sparse operations, which requires meschach[0123].shar, use - - configure --with-sparse - make sparse - make clean - - For including complex operations, which requires meschach[0124].shar, use - - configure --with-complex - make complex - make clean - - For including everything, which requires meschach[01234].shar, use - - configure --with-all - make all - make clean - - To compile the complete library in single precision (with Real equivalent -to float), add the --with-float option to configure, use - - configure --with-all --with-float - make all - make clean - - - Some Unix-like systems may have some problems with this due to bugs or -incompatibilities in various parts of the system. To check this use make -torture and run torture. In this case use the machine-dependent files from -the machines directory. (This is the case for RS/6000 machines, the -O -switch results in failure of a routine in schur.c. Compiling without the --O switch results in correct results.) - - If you have problems using configure, or you use a non-Unix system, -check the MACHINES directory (generated by meschach0.shar) for your -machine, operating system and/or compiler. Save the machine dependent -files makefile, machine.c and machine.h. Copy those files from the -directory for your machine to the directory where the source code is. - - To link into a program prog.c, compile it using - - cc -o prog_name prog.c ....(source files).... meschach.a -lm - - - This code has been mostly developed on the University of Queensland, -Australia's Pyramid 9810 running BSD4.3. Initial development was on a -Zilog Zeus Z8000 machine running Zeus, a Unix workalike operating system. -Versions have also been successfully used on various Unix machines -including Sun 3's, IBM RT's, SPARC's and an IBM RS/6000 running AIX. It -has also been compiled on an IBM AT clone using Quick C. It has been -designed to compile under either Kernighan and Richie, (Edition 1) C and -under ANSI C. (And, indeed, it has been compiled in both ANSI C and -non-ANSI C environments.) - - - b) On non-Unix machines - - First look in the machines directory for your system type. If it is -there, then copy the machine dependent files machine.h, makefile (and -possibly machine.c) to the Meschach directory. - - If your machine type is not there, then you will need to either compile -``by hand'', or construct your own makefile and possibly machine.h as well. -The machine-dependent files for various systems should be used as a -starting point, and the ``vanilla'' version of machine.h should be used. -Information on the machine-dependent files follows in the next three -subsections. - - On an IBM PC clone, the source code would be on a floppy disk. Use - - xcopy a:* meschach - -to copy it to the meschach directory. Then ``cd meschach'', and then -compile the source code. Different compilers on MSDOS machines will -require different installation procedures. Check the directory meschach -for the appropriate ``makefile'' for your compiler. If your compiler is -not listed, then you should try compiling it ``by hand'', modifying the -machine-dependent files as necessary. - - Worst come to worst, for a given C compiler, execute - <C compiler name> *.c -on MS-DOS machines. For example, - tcc *.c -for Turbo C, and - msc *.c -for Microsoft C, or if you are using Quick C, - qcl *.c -and of course - cc *.c -for the standard Unix compiler. - - Once the object files have been generated, you will need to combine them -into a library. Consult your local compiler's manual for details of how to -do this. - - When compiling programs/routines that use Meschach, you will need to -have access the the header files in the INCLUDE directory. The INCLUDE -directory's contents can be copied to the directory where the -programs/routines are compiled. - - The files in the DOC directory form a very brief form of documentation -on the the library routines in Meschach. See the printed documentation for -more comprehensive documentation of the Meschach routines. This can be -obtained from the authors via email. - - The files and directories created by the machines.shar shell archive -contain the files machine.c machine.h and makefile for a particular -machine/operating system/compiler where they need to be different. Copy -the files in the appropriate directory for your machine/operating -system/compiler to the directory with the Meschach source before compiling. - - - - c) makefile - - - This is setup by using the configure script on a Unix system, based on -the makefile.in file. However, if you want to modify how the library is -compiled, you are free to change the makefile. - - The most likely change that you would want to make to this file is to -change the line - - CFLAGS = -O - -to suit your particular compiler. - - The code is intended to be compilable by both ANSI and non-ANSI -compilers. - - To achieve this portability without sacrificing the ANSI function -prototypes (which are very useful for avoiding problems with passing -parameters) there is a token ANSI_C which must be #define'd in order to -take full advantage of ANSI C. To do this you should do all compilations -with - - #define ANSI_C 1 - - This can also be done at the compilation stage with a -DANSI_C flag. -Again, you will have to use the -DANSI_C flag or its equivalent whenever -you compile, or insert the line - - #define ANSI_C 1 - -in machine.h, to make full use of ANSI C with this matrix library. - - - d) machine.h - - Like makefile this is normally set up by the configure script on Unix -machines. However, for non-Unix systems, or if you need to set some things -``by hand'', change machine.h. - - There are a few quantities in here that should be modified to suit your -particular compiler. Firstly, the macros MEM_COPY() and MEM_ZERO() need to -be correctly defined here. The original library was compiled on BSD -systems, and so it originally relied on bcopy() and bzero(). - - In machine.h you will find the definitions for using the standard ANSI C -library routines: - - /*--------------------ANSI C--------------------*/ - #include <stddef.h> - #include <string.h> - #define MEM_COPY(from,to,size) memmove((to),(from),(size)) - #define MEM_ZERO(where,size) memset((where),'\0',(size)) - - Delete or comment out the alternative definitions and it should compile -correctly. The source files containing memmove() and/or memset() are -available by anonymous ftp from some ftp sites (try archie to discover -them). The files are usually called memmove.c or memset.c. -Some ftp sites which currently (Jan '94) have a version of these files are -munnari.oz.au (in Australia), ftp.uu.net, gatekeeper.dec.com (USA), and -unix.hensa.ac.uk (in the UK). The directory in which you will find -memmove.c and memset.c typically looks like .../bsd-sources/lib/libc/... - - There are two further machine-dependent quantities that should be set. -These are machine epsilon or the unit roundoff for double precision -arithmetic, and the maximum value produced by the rand() routine, which is -used in rand_vec() and rand_mat(). - - - The current definitions of these are - - #define MACHEPS 2.2e-16 - #define MAX_RAND 2.147483648e9 - - The value of MACHEPS should be correct for all IEEE standard double -precision arithmetic. - - However, ANSI C's <float.h> contains #define'd quantities DBL_EPSILON -and RAND_MAX, so if you have an ANSI C compiler and headers, replace the -above two lines of machine.h with - - #include <float.h> - /* for Real == float */ - #define MACHEPS DBL_EPSILON - #define MAX_RAND RAND_MAX - - The default value given for MAX_RAND is 2^31 , as the Pyramid 9810 and -the SPARC 2's both have 32 bit words. There is a program macheps.c which -is included in your source files which computes and prints out the value of -MACHEPS for your machine. - - Some other macros control some aspects of Meschach. One of these is -SEGMENTED which should be #define'd if you are working with a machine or -compiler that does not allow large arrays to be allocated. For example, -the most common memory models for MS-DOS compilers do not allow more than -64Kbyte to be allocated in one block. This limits square matrices to be no -more than 9090 . Inserting #define SEGMENTED 1 into machine.h will mean -that matrices are allocated a row at a time. - - - - 4. SAMPLE TESTS - - There are several programs for checking Meschach called torture -(source: torture.c) for the dense routines, sptort (source: sptort.c) for -the sparse routines, ztorture (source ztorture.c) for a complex version of -torture, memtort (source memtort.c) for memory allocation/deallocation, -itertort (source itertort.c) for iterative methods, mfuntort (source -mfuntort.c) for computing powers of dense matrices, iotort (source -iotort.c) for I/O routines. These can be compiled using make by "make -torture", "make sptort", etc. The programs are part of meschach0.shar. - - - 5. OTHER PROBLEMS - - Meschach is not a commercial package, so we do not guarantee that -everything will be perfect or will install smoothly. Inevitably there will -be unforeseen problems. If you come across any bugs or inconsistencies, please -let us know. If you need to modify the results of the configure script, or -need to construct your own machine.h and makefile's, please send them to -us. A number of people sent us the machine dependent files for Meschach 1.1, -but with the use of configure, and the new information needed for version -1.2, these machine dependent files don't have quite the right information. -Hopefully, though, they are redundant. Non-Unix platforms at present -require ``manual'' installation. Because of the variety of platforms -(MS-DOS, Macintosh, VAX/VMS, Prime, Amiga, Atari, ....) this is left up to -the users of these platforms. We hope that you can use the distibutable -machine-dependent files as a starting point for this task. - - If you have programs or routines written using Meschach v.1.1x, you -should put the statement - - #include "oldnames.h" - -at the beginning of your files. This is because a large number of the -names of the routines have been changed (e.g. "get_vec()" has become -"v_get()"). This will enable you to use the old names, although all of the -error messages etc., will use the new names. Also note that the new -iterative routines have a very different calling sequence. If you need the -old iterative routines, they are in oldmeschach.shar. - - If you wish to let us know what you have done, etc., our email -addresses are - - david.stewart@anu.edu.au - zbigniew.leyk@anu.edu.au - - Good luck! - - - ACKNOWLEDGMENTS - - - Many people have helped in various ways with ideas and suggestions. -Needless to say, the bugs are all ours! But these people should be thanked -for their encouragement etc. These include a number of people at -University of Queensland: Graeme Chandler, David De Wit, Martin Sharry, -Michael Forbes, Phil Kilby, John Holt, Phil Pollett and Tony Watts. At the -Australian National University: Mike Osborne, Steve Roberts, Margaret Kahn -and Teresa Leyk. Karen George of the University of Canberra has been a -source of both ideas and encouragement. Email has become significant part -of work, and many people have pointed out bugs, inconsistencies and -improvements to Meschach by email. These people include Ajay Shah of the -University of Southern California, Dov Grobgeld of the Weizmann Institute, -John Edstrom of the University of Calgary, Eric Grosse, one of the netlib -organisers, Ole Saether of Oslo, Norway, Alfred Thiele and Pierre -Asselin of Carnegie-Mellon Univeristy, Daniel Polani of the University of -Mainz, Marian Slodicka of Slovakia, Kaifu Wu of Pomona, Hidetoshi -Shimodaira of the University of Tokyo, Eng Siong of Edinburgh, Hirokawa Rui -of the University of Tokyo, Marko Slyz of the University of Michigan, and -Brook Milligan of the University of Texas. This list is only partial, and -there are many others who have corresponded with us on details about -Meschach and the like. Finally our thanks go to all those that have had to -struggle with compilers and other things to get Meschach to work. - - - - - //GO.SYSIN DD README echo configure 1>&2 sed >configure <<'//GO.SYSIN DD configure' 's/^-//' -#!/bin/sh -# Guess values for system-dependent variables and create Makefiles. -# Generated automatically using autoconf. -# Copyright (C) 1991, 1992, 1993 Free Software Foundation, Inc. - -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. - -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -# Usage: configure [--srcdir=DIR] [--host=HOST] [--gas] [--nfp] [--no-create] -# [--prefix=PREFIX] [--exec-prefix=PREFIX] [--with-PACKAGE] [TARGET] -# Ignores all args except --srcdir, --prefix, --exec-prefix, --no-create, and -# --with-PACKAGE unless this script has special code to handle it. - - -for arg -do - # Handle --exec-prefix with a space before the argument. - if test x$next_exec_prefix = xyes; then exec_prefix=$arg; next_exec_prefix= - # Handle --host with a space before the argument. - elif test x$next_host = xyes; then next_host= - # Handle --prefix with a space before the argument. - elif test x$next_prefix = xyes; then prefix=$arg; next_prefix= - # Handle --srcdir with a space before the argument. - elif test x$next_srcdir = xyes; then srcdir=$arg; next_srcdir= - else - case $arg in - # For backward compatibility, also recognize exact --exec_prefix. - -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* | --exec=* | --exe=* | --ex=* | --e=*) - exec_prefix=`echo $arg | sed 's/[-a-z_]*=//'` ;; - -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- | --exec | --exe | --ex | --e) - next_exec_prefix=yes ;; - - -gas | --gas | --ga | --g) ;; - - -host=* | --host=* | --hos=* | --ho=* | --h=*) ;; - -host | --host | --hos | --ho | --h) - next_host=yes ;; - - -nfp | --nfp | --nf) ;; - - -no-create | --no-create | --no-creat | --no-crea | --no-cre | --no-cr | --no-c | --no- | --no) - no_create=1 ;; - - -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) - prefix=`echo $arg | sed 's/[-a-z_]*=//'` ;; - -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) - next_prefix=yes ;; - - -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=* | --s=*) - srcdir=`echo $arg | sed 's/[-a-z_]*=//'` ;; - -srcdir | --srcdir | --srcdi | --srcd | --src | --sr | --s) - next_srcdir=yes ;; - - -with-* | --with-*) - package=`echo $arg|sed 's/-*with-//'` - # Delete all the valid chars; see if any are left. - if test -n "`echo $package|sed 's/[-a-zA-Z0-9_]*//g'`"; then - echo "configure: $package: invalid package name" >&2; exit 1 - fi - eval "with_`echo $package|sed s/-/_/g`=1" ;; - - -v | -verbose | --verbose | --verbos | --verbo | --verb | --ver | --ve | --v) - verbose=yes ;; - - *) ;; - esac - fi -done - -trap 'rm -f conftest* core; exit 1' 1 3 15 - -# Needed for some versions of `tr' so that character classes in `[]' work. -if test "${LANG+set}" = "set" ; then - LANG=C -fi - -rm -f conftest* -compile='${CC-cc} $CFLAGS $DEFS conftest.c -o conftest $LIBS >/dev/null 2>&1' - -# A filename unique to this package, relative to the directory that -# configure is in, which we can look for to find out if srcdir is correct. -unique_file=err.c - -# Find the source files, if location was not specified. -if test -z "$srcdir"; then - srcdirdefaulted=yes - # Try the directory containing this script, then `..'. - prog=$0 - confdir=`echo $prog|sed 's%/[^/][^/]*$%%'` - test "X$confdir" = "X$prog" && confdir=. - srcdir=$confdir - if test ! -r $srcdir/$unique_file; then - srcdir=.. - fi -fi -if test ! -r $srcdir/$unique_file; then - if test x$srcdirdefaulted = xyes; then - echo "configure: Can not find sources in \`${confdir}' or \`..'." 1>&2 - else - echo "configure: Can not find sources in \`${srcdir}'." 1>&2 - fi - exit 1 -fi -# Preserve a srcdir of `.' to avoid automounter screwups with pwd. -# But we can't avoid them for `..', to make subdirectories work. -case $srcdir in - .|/*|~*) ;; - *) srcdir=`cd $srcdir; pwd` ;; # Make relative path absolute. -esac - - -PROGS="" -if test -z "$CC"; then - # Extract the first word of `acc', so it can be a program name with args. - set dummy acc; word=$2 - echo checking for $word - IFS="${IFS= }"; saveifs="$IFS"; IFS="${IFS}:" - for dir in $PATH; do - test -z "$dir" && dir=. - if test -f $dir/$word; then - CC="acc" - break - fi - done - IFS="$saveifs" -fi -test -z "$CC" && CC="""" -test -n "$CC" -a -n "$verbose" && echo " setting CC to $CC" - -if test -z "$CC"; then - # Extract the first word of `cc', so it can be a program name with args. - set dummy cc; word=$2 - echo checking for $word - IFS="${IFS= }"; saveifs="$IFS"; IFS="${IFS}:" - for dir in $PATH; do - test -z "$dir" && dir=. - if test -f $dir/$word; then - CC="cc" - break - fi - done - IFS="$saveifs" -fi -test -z "$CC" && CC="gcc" -test -n "$CC" -a -n "$verbose" && echo " setting CC to $CC" - -echo checking how to run the C preprocessor -if test -z "$CPP"; then - CPP='${CC-cc} -E' - cat > conftest.c <<EOF -#include <stdio.h> -EOF -err=`eval "($CPP \$DEFS conftest.c >/dev/null) 2>&1"` -if test -z "$err"; then - : -else - CPP=/lib/cpp -fi -rm -f conftest* -fi - -echo checking for AIX -cat > conftest.c <<EOF -#ifdef _AIX - yes -#endif - -EOF -eval "$CPP \$DEFS conftest.c > conftest.out 2>&1" -if egrep "yes" conftest.out >/dev/null 2>&1; then - { -test -n "$verbose" && \ -echo ' defining' _ALL_SOURCE -DEFS="$DEFS -D_ALL_SOURCE=1" -SEDDEFS="${SEDDEFS}\${SEDdA}_ALL_SOURCE\${SEDdB}_ALL_SOURCE\${SEDdC}1\${SEDdD} -\${SEDuA}_ALL_SOURCE\${SEDuB}_ALL_SOURCE\${SEDuC}1\${SEDuD} -\${SEDeA}_ALL_SOURCE\${SEDeB}_ALL_SOURCE\${SEDeC}1\${SEDeD} -" -} - -fi -rm -f conftest* - - -echo checking for minix/config.h -cat > conftest.c <<EOF -#include <minix/config.h> -EOF -err=`eval "($CPP \$DEFS conftest.c >/dev/null) 2>&1"` -if test -z "$err"; then - MINIX=1 -fi -rm -f conftest* - -# The Minix shell can't assign to the same variable on the same line! -if test -n "$MINIX"; then - { -test -n "$verbose" && \ -echo ' defining' _POSIX_SOURCE -DEFS="$DEFS -D_POSIX_SOURCE=1" -SEDDEFS="${SEDDEFS}\${SEDdA}_POSIX_SOURCE\${SEDdB}_POSIX_SOURCE\${SEDdC}1\${SEDdD} -\${SEDuA}_POSIX_SOURCE\${SEDuB}_POSIX_SOURCE\${SEDuC}1\${SEDuD} -\${SEDeA}_POSIX_SOURCE\${SEDeB}_POSIX_SOURCE\${SEDeC}1\${SEDeD} -" -} - - { -test -n "$verbose" && \ -echo ' defining' _POSIX_1_SOURCE to be '2' -DEFS="$DEFS -D_POSIX_1_SOURCE=2" -SEDDEFS="${SEDDEFS}\${SEDdA}_POSIX_1_SOURCE\${SEDdB}_POSIX_1_SOURCE\${SEDdC}2\${SEDdD} -\${SEDuA}_POSIX_1_SOURCE\${SEDuB}_POSIX_1_SOURCE\${SEDuC}2\${SEDuD} -\${SEDeA}_POSIX_1_SOURCE\${SEDeB}_POSIX_1_SOURCE\${SEDeC}2\${SEDeD} -" -} - - { -test -n "$verbose" && \ -echo ' defining' _MINIX -DEFS="$DEFS -D_MINIX=1" -SEDDEFS="${SEDDEFS}\${SEDdA}_MINIX\${SEDdB}_MINIX\${SEDdC}1\${SEDdD} -\${SEDuA}_MINIX\${SEDuB}_MINIX\${SEDuC}1\${SEDuD} -\${SEDeA}_MINIX\${SEDeB}_MINIX\${SEDeC}1\${SEDeD} -" -} - -fi - -echo checking for POSIXized ISC -if test -d /etc/conf/kconfig.d && - grep _POSIX_VERSION /usr/include/sys/unistd.h >/dev/null 2>&1 -then - ISC=1 # If later tests want to check for ISC. - { -test -n "$verbose" && \ -echo ' defining' _POSIX_SOURCE -DEFS="$DEFS -D_POSIX_SOURCE=1" -SEDDEFS="${SEDDEFS}\${SEDdA}_POSIX_SOURCE\${SEDdB}_POSIX_SOURCE\${SEDdC}1\${SEDdD} -\${SEDuA}_POSIX_SOURCE\${SEDuB}_POSIX_SOURCE\${SEDuC}1\${SEDuD} -\${SEDeA}_POSIX_SOURCE\${SEDeB}_POSIX_SOURCE\${SEDeC}1\${SEDeD} -" -} - - if test -n "$GCC"; then - CC="$CC -posix" - else - CC="$CC -Xp" - fi -fi - -if test -z "$RANLIB"; then - # Extract the first word of `ranlib', so it can be a program name with args. - set dummy ranlib; word=$2 - echo checking for $word - IFS="${IFS= }"; saveifs="$IFS"; IFS="${IFS}:" - for dir in $PATH; do - test -z "$dir" && dir=. - if test -f $dir/$word; then - RANLIB="ranlib" - break - fi - done - IFS="$saveifs" -fi -test -z "$RANLIB" && RANLIB=":" -test -n "$RANLIB" -a -n "$verbose" && echo " setting RANLIB to $RANLIB" - -for hdr in memory.h -do -trhdr=HAVE_`echo $hdr | tr '[a-z]./' '[A-Z]__'` -echo checking for ${hdr} -cat > conftest.c <<EOF -#include <${hdr}> -EOF -err=`eval "($CPP \$DEFS conftest.c >/dev/null) 2>&1"` -if test -z "$err"; then - { -test -n "$verbose" && \ -echo ' defining' ${trhdr} -DEFS="$DEFS -D${trhdr}=1" -SEDDEFS="${SEDDEFS}\${SEDdA}${trhdr}\${SEDdB}${trhdr}\${SEDdC}1\${SEDdD} -\${SEDuA}${trhdr}\${SEDuB}${trhdr}\${SEDuC}1\${SEDuD} -\${SEDeA}${trhdr}\${SEDeB}${trhdr}\${SEDeC}1\${SEDeD} -" -} - -fi -rm -f conftest* -done - -echo checking for ANSI C header files -cat > conftest.c <<EOF -#include <stdlib.h> -#include <stdarg.h> -#include <string.h> -#include <float.h> -EOF -err=`eval "($CPP \$DEFS conftest.c >/dev/null) 2>&1"` -if test -z "$err"; then - # SunOS 4.x string.h does not declare mem*, contrary to ANSI. -echo '#include <string.h>' > conftest.c -eval "$CPP \$DEFS conftest.c > conftest.out 2>&1" -if egrep "memchr" conftest.out >/dev/null 2>&1; then - # SGI's /bin/cc from Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. -cat > conftest.c <<EOF -#include <ctype.h> -#define ISLOWER(c) ('a' <= (c) && (c) <= 'z') -#define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) -#define XOR(e,f) (((e) && !(f)) || (!(e) && (f))) -int main () { int i; for (i = 0; i < 256; i++) -if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2); -exit (0); } - -EOF -eval $compile -if test -s conftest && (./conftest; exit) 2>/dev/null; then - { -test -n "$verbose" && \ -echo ' defining' STDC_HEADERS -DEFS="$DEFS -DSTDC_HEADERS=1" -SEDDEFS="${SEDDEFS}\${SEDdA}STDC_HEADERS\${SEDdB}STDC_HEADERS\${SEDdC}1\${SEDdD} -\${SEDuA}STDC_HEADERS\${SEDuB}STDC_HEADERS\${SEDuC}1\${SEDuD} -\${SEDeA}STDC_HEADERS\${SEDeB}STDC_HEADERS\${SEDeC}1\${SEDeD} -" -} - -fi -rm -f conftest* -fi -rm -f conftest* - -fi -rm -f conftest* - -echo checking for complex.h -cat > conftest.c <<EOF -#include <complex.h> -EOF -err=`eval "($CPP \$DEFS conftest.c >/dev/null) 2>&1"` -if test -z "$err"; then - { -test -n "$verbose" && \ -echo ' defining' HAVE_COMPLEX_H -DEFS="$DEFS -DHAVE_COMPLEX_H=1" -SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_COMPLEX_H\${SEDdB}HAVE_COMPLEX_H\${SEDdC}1\${SEDdD} -\${SEDuA}HAVE_COMPLEX_H\${SEDuB}HAVE_COMPLEX_H\${SEDuC}1\${SEDuD} -\${SEDeA}HAVE_COMPLEX_H\${SEDeB}HAVE_COMPLEX_H\${SEDeC}1\${SEDeD} -" -} - -fi -rm -f conftest* - -echo checking for malloc.h -cat > conftest.c <<EOF -#include <malloc.h> -EOF -err=`eval "($CPP \$DEFS conftest.c >/dev/null) 2>&1"` -if test -z "$err"; then - { -test -n "$verbose" && \ -echo ' defining' HAVE_MALLOC_H -DEFS="$DEFS -DHAVE_MALLOC_H=1" -SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_MALLOC_H\${SEDdB}HAVE_MALLOC_H\${SEDdC}1\${SEDdD} -\${SEDuA}HAVE_MALLOC_H\${SEDuB}HAVE_MALLOC_H\${SEDuC}1\${SEDuD} -\${SEDeA}HAVE_MALLOC_H\${SEDeB}HAVE_MALLOC_H\${SEDeC}1\${SEDeD} -" -} - -fi -rm -f conftest* - -echo checking for varargs.h -cat > conftest.c <<EOF -#include <varargs.h> -EOF -err=`eval "($CPP \$DEFS conftest.c >/dev/null) 2>&1"` -if test -z "$err"; then - { -test -n "$verbose" && \ -echo ' defining' VARARGS -DEFS="$DEFS -DVARARGS=1" -SEDDEFS="${SEDDEFS}\${SEDdA}VARARGS\${SEDdB}VARARGS\${SEDdC}1\${SEDdD} -\${SEDuA}VARARGS\${SEDuB}VARARGS\${SEDuC}1\${SEDuD} -\${SEDeA}VARARGS\${SEDeB}VARARGS\${SEDeC}1\${SEDeD} -" -} - -fi -rm -f conftest* - -{ -test -n "$verbose" && \ -echo ' defining' NOT_SEGMENTED -DEFS="$DEFS -DNOT_SEGMENTED=1" -SEDDEFS="${SEDDEFS}\${SEDdA}NOT_SEGMENTED\${SEDdB}NOT_SEGMENTED\${SEDdC}1\${SEDdD} -\${SEDuA}NOT_SEGMENTED\${SEDuB}NOT_SEGMENTED\${SEDuC}1\${SEDuD} -\${SEDeA}NOT_SEGMENTED\${SEDeB}NOT_SEGMENTED\${SEDeC}1\${SEDeD} -" -} - -echo checking for size_t in sys/types.h -echo '#include <sys/types.h>' > conftest.c -eval "$CPP \$DEFS conftest.c > conftest.out 2>&1" -if egrep "size_t" conftest.out >/dev/null 2>&1; then - : -else - { -test -n "$verbose" && \ -echo ' defining' size_t to be 'unsigned' -DEFS="$DEFS -Dsize_t=unsigned" -SEDDEFS="${SEDDEFS}\${SEDdA}size_t\${SEDdB}size_t\${SEDdC}unsigned\${SEDdD} -\${SEDuA}size_t\${SEDuB}size_t\${SEDuC}unsigned\${SEDuD} -\${SEDeA}size_t\${SEDeB}size_t\${SEDeC}unsigned\${SEDeD} -" -} - -fi -rm -f conftest* - -prog='/* Ultrix mips cc rejects this. */ -typedef int charset[2]; const charset x; -/* SunOS 4.1.1 cc rejects this. */ -char const *const *ccp; -char **p; -/* AIX XL C 1.02.0.0 rejects this. - It does not let you subtract one const X* pointer from another in an arm - of an if-expression whose if-part is not a constant expression */ -const char *g = "string"; -p = &g + (g ? g-g : 0); -/* HPUX 7.0 cc rejects these. */ -++ccp; -p = (char**) ccp; -ccp = (char const *const *) p; -{ /* SCO 3.2v4 cc rejects this. */ - char *t; - char const *s = 0 ? (char *) 0 : (char const *) 0; - - *t++ = 0; -} -{ /* Someone thinks the Sun supposedly-ANSI compiler will reject this. */ - int x[] = {25,17}; - const int *foo = &x[0]; - ++foo; -} -{ /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */ - typedef const int *iptr; - iptr p = 0; - ++p; -} -{ /* AIX XL C 1.02.0.0 rejects this saying - "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */ - struct s { int j; const int *ap[3]; }; - struct s *b; b->j = 5; -}' -echo checking for working const -cat > conftest.c <<EOF - -int main() { exit(0); } -int t() { $prog } -EOF -if eval $compile; then - : -else - { -test -n "$verbose" && \ -echo ' defining' const to be 'empty' -DEFS="$DEFS -Dconst=" -SEDDEFS="${SEDDEFS}\${SEDdA}const\${SEDdB}const\${SEDdC}\${SEDdD} -\${SEDuA}const\${SEDuB}const\${SEDuC}\${SEDuD} -\${SEDeA}const\${SEDeB}const\${SEDeC}\${SEDeD} -" -} - -fi -rm -f conftest* - -echo checking byte ordering -cat > conftest.c <<EOF -main () { - /* Are we little or big endian? From Harbison&Steele. */ - union - { - long l; - char c[sizeof (long)]; - } u; - u.l = 1; - exit (u.c[sizeof (long) - 1] == 1); -} -EOF -eval $compile -if test -s conftest && (./conftest; exit) 2>/dev/null; then - : -else - { -test -n "$verbose" && \ -echo ' defining' WORDS_BIGENDIAN -DEFS="$DEFS -DWORDS_BIGENDIAN=1" -SEDDEFS="${SEDDEFS}\${SEDdA}WORDS_BIGENDIAN\${SEDdB}WORDS_BIGENDIAN\${SEDdC}1\${SEDdD} -\${SEDuA}WORDS_BIGENDIAN\${SEDuB}WORDS_BIGENDIAN\${SEDuC}1\${SEDuD} -\${SEDeA}WORDS_BIGENDIAN\${SEDeB}WORDS_BIGENDIAN\${SEDeC}1\${SEDeD} -" -} - -fi -rm -f conftest* - -# check whether --with-complex was given -if test -n "$with_complex"; then - { -test -n "$verbose" && \ -echo ' defining' COMPLEX -DEFS="$DEFS -DCOMPLEX=1" -SEDDEFS="${SEDDEFS}\${SEDdA}COMPLEX\${SEDdB}COMPLEX\${SEDdC}1\${SEDdD} -\${SEDuA}COMPLEX\${SEDuB}COMPLEX\${SEDuC}1\${SEDuD} -\${SEDeA}COMPLEX\${SEDeB}COMPLEX\${SEDeC}1\${SEDeD} -" -} - -fi - -# check whether --with-sparse was given -if test -n "$with_sparse"; then - { -test -n "$verbose" && \ -echo ' defining' SPARSE -DEFS="$DEFS -DSPARSE=1" -SEDDEFS="${SEDDEFS}\${SEDdA}SPARSE\${SEDdB}SPARSE\${SEDdC}1\${SEDdD} -\${SEDuA}SPARSE\${SEDuB}SPARSE\${SEDuC}1\${SEDuD} -\${SEDeA}SPARSE\${SEDeB}SPARSE\${SEDeC}1\${SEDeD} -" -} - -fi - -# check whether --with-all was given -if test -n "$with_all"; then - { -test -n "$verbose" && \ -echo ' defining' COMPLEX -DEFS="$DEFS -DCOMPLEX=1" -SEDDEFS="${SEDDEFS}\${SEDdA}COMPLEX\${SEDdB}COMPLEX\${SEDdC}1\${SEDdD} -\${SEDuA}COMPLEX\${SEDuB}COMPLEX\${SEDuC}1\${SEDuD} -\${SEDeA}COMPLEX\${SEDeB}COMPLEX\${SEDeC}1\${SEDeD} -" -} - -fi - -# check whether --with-all was given -if test -n "$with_all"; then - { -test -n "$verbose" && \ -echo ' defining' SPARSE -DEFS="$DEFS -DSPARSE=1" -SEDDEFS="${SEDDEFS}\${SEDdA}SPARSE\${SEDdB}SPARSE\${SEDdC}1\${SEDdD} -\${SEDuA}SPARSE\${SEDuB}SPARSE\${SEDuC}1\${SEDuD} -\${SEDeA}SPARSE\${SEDeB}SPARSE\${SEDeC}1\${SEDeD} -" -} - -fi - -# check whether --with-unroll was given -if test -n "$with_unroll"; then - { -test -n "$verbose" && \ -echo ' defining' VUNROLL -DEFS="$DEFS -DVUNROLL=1" -SEDDEFS="${SEDDEFS}\${SEDdA}VUNROLL\${SEDdB}VUNROLL\${SEDdC}1\${SEDdD} -\${SEDuA}VUNROLL\${SEDuB}VUNROLL\${SEDuC}1\${SEDuD} -\${SEDeA}VUNROLL\${SEDeB}VUNROLL\${SEDeC}1\${SEDeD} -" -} - -fi - -# check whether --with-munroll was given -if test -n "$with_munroll"; then - { -test -n "$verbose" && \ -echo ' defining' MUNROLL -DEFS="$DEFS -DMUNROLL=1" -SEDDEFS="${SEDDEFS}\${SEDdA}MUNROLL\${SEDdB}MUNROLL\${SEDdC}1\${SEDdD} -\${SEDuA}MUNROLL\${SEDuB}MUNROLL\${SEDuC}1\${SEDuD} -\${SEDeA}MUNROLL\${SEDeB}MUNROLL\${SEDeC}1\${SEDeD} -" -} - -fi - -# check whether --with-segmem was given -if test -n "$with_segmem"; then - { -test -n "$verbose" && \ -echo ' defining' SEGMENTED -DEFS="$DEFS -DSEGMENTED=1" -SEDDEFS="${SEDDEFS}\${SEDdA}SEGMENTED\${SEDdB}SEGMENTED\${SEDdC}1\${SEDdD} -\${SEDuA}SEGMENTED\${SEDuB}SEGMENTED\${SEDuC}1\${SEDuD} -\${SEDeA}SEGMENTED\${SEDeB}SEGMENTED\${SEDeC}1\${SEDeD} -" -} - -fi - -# check whether --with-float was given -if test -n "$with_float"; then - { -test -n "$verbose" && \ -echo ' defining' REAL_FLT -DEFS="$DEFS -DREAL_FLT=1" -SEDDEFS="${SEDDEFS}\${SEDdA}REAL_FLT\${SEDdB}REAL_FLT\${SEDdC}1\${SEDdD} -\${SEDuA}REAL_FLT\${SEDuB}REAL_FLT\${SEDuC}1\${SEDuD} -\${SEDeA}REAL_FLT\${SEDeB}REAL_FLT\${SEDeC}1\${SEDeD} -" -} - -fi - -# check whether --with-double was given -if test -n "$with_double"; then - { -test -n "$verbose" && \ -echo ' defining' REAL_DBL -DEFS="$DEFS -DREAL_DBL=1" -SEDDEFS="${SEDDEFS}\${SEDdA}REAL_DBL\${SEDdB}REAL_DBL\${SEDdC}1\${SEDdD} -\${SEDuA}REAL_DBL\${SEDuB}REAL_DBL\${SEDuC}1\${SEDuD} -\${SEDeA}REAL_DBL\${SEDeB}REAL_DBL\${SEDeC}1\${SEDeD} -" -} - -fi - -LIBS="$LIBS -lm" -echo checking for u_int -cat > conftest.c <<EOF -#include <stdio.h> -#ifdef __STDC__ -#include <stdlib.h> -#endif -int main() { exit(0); } -int t() { u_int i; i = 1; } -EOF -if eval $compile; then - { -test -n "$verbose" && \ -echo ' defining' U_INT_DEF -DEFS="$DEFS -DU_INT_DEF=1" -SEDDEFS="${SEDDEFS}\${SEDdA}U_INT_DEF\${SEDdB}U_INT_DEF\${SEDdC}1\${SEDdD} -\${SEDuA}U_INT_DEF\${SEDuB}U_INT_DEF\${SEDuC}1\${SEDuD} -\${SEDeA}U_INT_DEF\${SEDeB}U_INT_DEF\${SEDeC}1\${SEDeD} -" -} - -fi -rm -f conftest* - -echo 'computing machine epsilon(s)' -echo $CC -o macheps dmacheps.c -$CC -o macheps dmacheps.c -{ -test -n "$verbose" && \ -echo ' defining' D_MACHEPS to be '`macheps`' -DEFS="$DEFS -DD_MACHEPS=`macheps`" -SEDDEFS="${SEDDEFS}\${SEDdA}D_MACHEPS\${SEDdB}D_MACHEPS\${SEDdC}`macheps`\${SEDdD} -\${SEDuA}D_MACHEPS\${SEDuB}D_MACHEPS\${SEDuC}`macheps`\${SEDuD} -\${SEDeA}D_MACHEPS\${SEDeB}D_MACHEPS\${SEDeC}`macheps`\${SEDeD} -" -} - -echo $CC -o macheps fmacheps.c -$CC -o macheps fmacheps.c -{ -test -n "$verbose" && \ -echo ' defining' F_MACHEPS to be '`macheps`' -DEFS="$DEFS -DF_MACHEPS=`macheps`" -SEDDEFS="${SEDDEFS}\${SEDdA}F_MACHEPS\${SEDdB}F_MACHEPS\${SEDdC}`macheps`\${SEDdD} -\${SEDuA}F_MACHEPS\${SEDuB}F_MACHEPS\${SEDuC}`macheps`\${SEDuD} -\${SEDeA}F_MACHEPS\${SEDeB}F_MACHEPS\${SEDeC}`macheps`\${SEDeD} -" -} - -echo computing M_MAX_INT -echo $CC -o maxint maxint.c -$CC -o maxint maxint.c -{ -test -n "$verbose" && \ -echo ' defining' M_MAX_INT to be '`maxint`' -DEFS="$DEFS -DM_MAX_INT=`maxint`" -SEDDEFS="${SEDDEFS}\${SEDdA}M_MAX_INT\${SEDdB}M_MAX_INT\${SEDdC}`maxint`\${SEDdD} -\${SEDuA}M_MAX_INT\${SEDuB}M_MAX_INT\${SEDuC}`maxint`\${SEDuD} -\${SEDeA}M_MAX_INT\${SEDeB}M_MAX_INT\${SEDeC}`maxint`\${SEDeD} -" -} - -echo checking char '\\0' vs. float zeros -cat > conftest.c <<EOF -main() { - char *cp = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"; - double *dp; - dp = (double *)cp; - if ( *dp == 0.0 ) printf("yes\n"); } - -EOF -eval "$CPP \$DEFS conftest.c > conftest.out 2>&1" -if egrep "yes" conftest.out >/dev/null 2>&1; then - { -test -n "$verbose" && \ -echo ' defining' CHAR0ISDBL0 -DEFS="$DEFS -DCHAR0ISDBL0=1" -SEDDEFS="${SEDDEFS}\${SEDdA}CHAR0ISDBL0\${SEDdB}CHAR0ISDBL0\${SEDdC}1\${SEDdD} -\${SEDuA}CHAR0ISDBL0\${SEDuB}CHAR0ISDBL0\${SEDuC}1\${SEDuD} -\${SEDeA}CHAR0ISDBL0\${SEDeB}CHAR0ISDBL0\${SEDeC}1\${SEDeD} -" -} - -fi -rm -f conftest* - -for func in bcopy bzero -do -trfunc=HAVE_`echo $func | tr '[a-z]' '[A-Z]'` -echo checking for ${func} -cat > conftest.c <<EOF -#include <ctype.h> -int main() { exit(0); } -int t() { -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_${func}) || defined (__stub___${func}) -choke me -#else -/* Override any gcc2 internal prototype to avoid an error. */ -extern char ${func}(); ${func}(); -#endif - } -EOF -if eval $compile; then - { -test -n "$verbose" && \ -echo ' defining' ${trfunc} -DEFS="$DEFS -D${trfunc}=1" -SEDDEFS="${SEDDEFS}\${SEDdA}${trfunc}\${SEDdB}${trfunc}\${SEDdC}1\${SEDdD} -\${SEDuA}${trfunc}\${SEDuB}${trfunc}\${SEDuC}1\${SEDuD} -\${SEDeA}${trfunc}\${SEDeB}${trfunc}\${SEDeC}1\${SEDeD} -" -} - -fi -rm -f conftest* -done - -echo checking for function prototypes -cat > conftest.c <<EOF - -int main() { exit(0); } -int t() { extern int test (int i, double x); } -EOF -if eval $compile; then - { -test -n "$verbose" && \ -echo ' defining' HAVE_PROTOTYPES -DEFS="$DEFS -DHAVE_PROTOTYPES=1" -SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_PROTOTYPES\${SEDdB}HAVE_PROTOTYPES\${SEDdC}1\${SEDdD} -\${SEDuA}HAVE_PROTOTYPES\${SEDuB}HAVE_PROTOTYPES\${SEDuC}1\${SEDuD} -\${SEDeA}HAVE_PROTOTYPES\${SEDeB}HAVE_PROTOTYPES\${SEDeC}1\${SEDeD} -" -} - -fi -rm -f conftest* - -if test -n "$prefix"; then - test -z "$exec_prefix" && exec_prefix='${prefix}' - prsub="s%^prefix\$[ ]*\$=\$[ ]*\$.*$%prefix\\1=\\2$prefix%" -fi -if test -n "$exec_prefix"; then - prsub="$prsub -s%^exec_prefix\$[ ]*\$=\$[ ]*\$.*$%\ -exec_prefix\\1=\\2$exec_prefix%" -fi -DEFS="`echo \"$DEFS\" | sed 's%[&\\\]%\\\&%g'`" - -trap 'rm -f config.status; exit 1' 1 3 15 -echo creating config.status -rm -f config.status -cat > config.status <<EOF -#!/bin/sh -# Generated automatically by configure. -# Run this file to recreate the current configuration. -# This directory was configured as follows, -# on host `(hostname || uname -n) 2>/dev/null | sed 1q`: -# -# $0 $* - -for arg -do - case "\$arg" in - -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) - exec /bin/sh $0 $* ;; - *) echo "Usage: config.status --recheck" 2>&1; exit 1 ;; - esac -done - -trap 'rm -f makefile machine.h conftest*; exit 1' 1 3 15 -PROGS='$PROGS' -CC='$CC' -CPP='$CPP' -RANLIB='$RANLIB' -LIBS='$LIBS' -srcdir='$srcdir' -prefix='$prefix' -exec_prefix='$exec_prefix' -prsub='$prsub' -EOF -cat >> config.status <<\EOF - -top_srcdir=$srcdir - -# Allow make-time overrides of the generated file list. -test -n "$gen_files" || gen_files="makefile" - -for file in .. $gen_files; do if [ "x$file" != "x.." ]; then - srcdir=$top_srcdir - # Remove last slash and all that follows it. Not all systems have dirname. - dir=`echo $file|sed 's%/[^/][^/]*$%%'` - if test "$dir" != "$file"; then - test "$top_srcdir" != . && srcdir=$top_srcdir/$dir - test ! -d $dir && mkdir $dir - fi - echo creating $file - rm -f $file - echo "# Generated automatically from `echo $file|sed 's|.*/||'`.in by configure." > $file - sed -e " -$prsub -s%@PROGS@%$PROGS%g -s%@CC@%$CC%g -s%@CPP@%$CPP%g -s%@RANLIB@%$RANLIB%g -s%@LIBS@%$LIBS%g -s%@srcdir@%$srcdir%g -s%@DEFS@%-DHAVE_CONFIG_H%" $top_srcdir/${file}.in >> $file -fi; done -test -n "$gen_config" || gen_config=machine.h -echo creating $gen_config -# These sed commands are put into SEDDEFS when defining a macro. -# They are broken into pieces to make the sed script easier to manage. -# They are passed to sed as "A NAME B NAME C VALUE D", where NAME -# is the cpp macro being defined and VALUE is the value it is being given. -# Each defining turns into a single global substitution command. -# -# SEDd sets the value in "#define NAME VALUE" lines. -SEDdA='s@^$[ ]*$#$[ ]*define[ ][ ]*$' -SEDdB='$[ ][ ]*$[^ ]*@\1#\2' -SEDdC='\3' -SEDdD='@g' -# SEDu turns "#undef NAME" with trailing blanks into "#define NAME VALUE". -SEDuA='s@^$[ ]*$#$[ ]*$undef$[ ][ ]*$' -SEDuB='$[ ]$@\1#\2define\3' -SEDuC=' ' -SEDuD='\4@g' -# SEDe turns "#undef NAME" without trailing blanks into "#define NAME VALUE". -SEDeA='s@^$[ ]*$#$[ ]*$undef$[ ][ ]*$' -SEDeB='$@\1#\2define\3' -SEDeC=' ' -SEDeD='@g' -rm -f conftest.sed -EOF -# Turn off quoting long enough to insert the sed commands. -rm -f conftest.sh -cat > conftest.sh <<EOF -$SEDDEFS -EOF - -# Maximum number of lines to put in a single here document. -maxshlines=9 - -# Break up $SEDDEFS (now in conftest.sh) because some shells have a limit -# on the size of here documents. - -while : -do - lines=`grep -c . conftest.sh` - if test -z "$lines" || test "$lines" -eq 0; then break; fi - rm -f conftest.s1 conftest.s2 - sed ${maxshlines}q conftest.sh > conftest.s1 # Like head -20. - sed 1,${maxshlines}d conftest.sh > conftest.s2 # Like tail +21. - # Write a limited-size here document to append to conftest.sed. - echo 'cat >> conftest.sed <<CONFEOF' >> config.status - cat conftest.s1 >> config.status - echo 'CONFEOF' >> config.status - rm -f conftest.s1 conftest.sh - mv conftest.s2 conftest.sh -done -rm -f conftest.sh - -# Now back to your regularly scheduled config.status. -cat >> config.status <<\EOF -# This sed command replaces #undef's with comments. This is necessary, for -# example, in the case of _POSIX_SOURCE, which is predefined and required -# on some systems where configure will not decide to define it in -# machine.h. -cat >> conftest.sed <<\CONFEOF -s,^[ ]*#[ ]*undef[ ][ ]*[a-zA-Z_][a-zA-Z_0-9]*,/* & */, -CONFEOF -rm -f conftest.h -# Break up the sed commands because old seds have small limits. -maxsedlines=20 -cp $top_srcdir/$gen_config.in conftest.h1 -while : -do - lines=`grep -c . conftest.sed` - if test -z "$lines" || test "$lines" -eq 0; then break; fi - rm -f conftest.s1 conftest.s2 conftest.h2 - sed ${maxsedlines}q conftest.sed > conftest.s1 # Like head -20. - sed 1,${maxsedlines}d conftest.sed > conftest.s2 # Like tail +21. - sed -f conftest.s1 < conftest.h1 > conftest.h2 - rm -f conftest.s1 conftest.h1 conftest.sed - mv conftest.h2 conftest.h1 - mv conftest.s2 conftest.sed -done -rm -f conftest.sed conftest.h -echo "/* $gen_config. Generated automatically by configure. */" > conftest.h -cat conftest.h1 >> conftest.h -rm -f conftest.h1 -if cmp -s $gen_config conftest.h 2>/dev/null; then - # The file exists and we would not be changing it. - rm -f conftest.h -else - rm -f $gen_config - mv conftest.h $gen_config -fi - - -exit 0 -EOF -chmod +x config.status -test -n "$no_create" || ./config.status - -echo "Extensions to basic version: use configure --with-opt1 --with-opt2" -echo " Option:" -echo " --with-complex incorporate complex functions" -echo " --with-sparse incorporate sparse matrix functions" -echo " --with-all both of the above" -echo " --with-unroll unroll low level loops on vectors" -echo " --with-munroll unroll low level loops on matrices" -echo " --with-float single precision" -echo " --with-double double precision (default)" -echo "Re-run configure with these options if you want them" -# configure.in copyright (C) Brook Milligan and David Stewart, 1993 //GO.SYSIN DD configure chmod +x configure echo configure.in 1>&2 sed >configure.in <<'//GO.SYSIN DD configure.in' 's/^-//' -dnl Meschach autoconf script -dnl Copyright (C) Brook Milligan and David Stewart, 1993 -dnl $Id: configure.in,v 1.3 1994/03/08 05:41:32 des Exp $ -dnl -dnl Brook Milligan's prototype check -dnl Check if $(CC) supports prototypes -define(LOCAL_HAVE_PROTOTYPES, -[AC_COMPILE_CHECK([function prototypes], , -[extern int test (int i, double x);], -AC_DEFINE(HAVE_PROTOTYPES))])dnl -dnl -dnl Brook Milligan's compiler check -dnl Check for the sun ansi c compiler, acc -define(LOCAL_PROG_ACC, -[AC_BEFORE([$0], [AC_PROG_CPP])AC_PROVIDE([$0])dnl -AC_PROGRAM_CHECK(CC, acc, acc, "")])dnl -dnl David Stewart's modified compiler check -define(LOCAL_PROG_CC, -[AC_BEFORE([$0], [AC_PROG_CPP])AC_PROVIDE([$0])dnl -AC_PROGRAM_CHECK(CC, acc, acc, cc)])dnl -dnl -dnl -dnl -dnl ---------------------------------------------------------------------- -dnl Start of configure.in proper -dnl ---------------------------------------------------------------------- -AC_INIT(err.c) -AC_CONFIG_HEADER(machine.h) -PROGS="" -AC_SUBST(PROGS)dnl -LOCAL_PROG_ACC -AC_PROGRAM_CHECK(CC, cc, cc, gcc) -dnl AC_PROG_CC -AC_PROG_CPP -AC_AIX -AC_MINIX -AC_ISC_POSIX -dnl -dnl Brook Milligan's prototype check -dnl Check if $(CC) supports prototypes in function declarations and structures -define(LOCAL_HAVE_PROTOTYPES, -[AC_COMPILE_CHECK([function prototypes], , -[extern int test (int i, double x);], -AC_DEFINE(HAVE_PROTOTYPES)) -AC_COMPILE_CHECK([function prototypes in structures], , -[struct s1 {int (*f) (int a);}; -struct s2 {int (*f) (double a);};], -AC_DEFINE(HAVE_PROTOTYPES_IN_STRUCT))])dnl -dnl -AC_PROG_RANLIB -AC_HAVE_HEADERS(memory.h) -AC_STDC_HEADERS -AC_HEADER_CHECK(complex.h, AC_DEFINE(HAVE_COMPLEX_H),) -AC_HEADER_CHECK(malloc.h, AC_DEFINE(HAVE_MALLOC_H),) -AC_HEADER_CHECK(varargs.h, AC_DEFINE(VARARGS),) -AC_DEFINE(NOT_SEGMENTED) -AC_SIZE_T -AC_CONST -AC_WORDS_BIGENDIAN -AC_WITH(complex, AC_DEFINE(COMPLEX)) -AC_WITH(sparse, AC_DEFINE(SPARSE)) -AC_WITH(all, AC_DEFINE(COMPLEX)) -AC_WITH(all, AC_DEFINE(SPARSE)) -AC_WITH(unroll, AC_DEFINE(VUNROLL)) -AC_WITH(munroll, AC_DEFINE(MUNROLL)) -AC_WITH(segmem, AC_DEFINE(SEGMENTED)) -AC_WITH(float, AC_DEFINE(REAL_FLT)) -AC_WITH(double, AC_DEFINE(REAL_DBL)) -LIBS="$LIBS -lm" -AC_COMPILE_CHECK([u_int],[#include <stdio.h> -#ifdef __STDC__ -#include <stdlib.h> -#endif],[u_int i; i = 1;],AC_DEFINE(U_INT_DEF)) -echo 'computing machine epsilon(s)' -echo $CC -o macheps dmacheps.c -$CC -o macheps dmacheps.c -AC_DEFINE_UNQUOTED(D_MACHEPS,`macheps`) -echo $CC -o macheps fmacheps.c -$CC -o macheps fmacheps.c -AC_DEFINE_UNQUOTED(F_MACHEPS,`macheps`) -echo computing M_MAX_INT -echo $CC -o maxint maxint.c -$CC -o maxint maxint.c -AC_DEFINE_UNQUOTED(M_MAX_INT,`maxint`) -echo checking char '\\0' vs. float zeros -AC_PROGRAM_EGREP(yes,[main() { - char *cp = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"; - double *dp; - dp = (double *)cp; - if ( *dp == 0.0 ) printf("yes\n"); } -],AC_DEFINE(CHAR0ISDBL0)) -AC_HAVE_FUNCS(bcopy bzero) -LOCAL_HAVE_PROTOTYPES -AC_OUTPUT(makefile) -echo "Extensions to basic version: use configure --with-opt1 --with-opt2" -echo " Option:" -echo " --with-complex incorporate complex functions" -echo " --with-sparse incorporate sparse matrix functions" -echo " --with-all both of the above" -echo " --with-unroll unroll low level loops on vectors" -echo " --with-munroll unroll low level loops on matrices" -echo " --with-float single precision" -echo " --with-double double precision (default)" -echo "Re-run configure with these options if you want them" -# configure.in copyright (C) Brook Milligan and David Stewart, 1993 //GO.SYSIN DD configure.in echo machine.h.in 1>&2 sed >machine.h.in <<'//GO.SYSIN DD machine.h.in' 's/^-//' -/* Any machine specific stuff goes here */ -/* Add details necessary for your own installation here! */ - -/* RCS id: $Id: machine.h.in,v 1.2 1994/03/13 23:07:30 des Exp $ */ - -/* This is for use with "configure" -- if you are not using configure - then use machine.van for the "vanilla" version of machine.h */ - -/* Note special macros: ANSI_C (ANSI C syntax) - SEGMENTED (segmented memory machine e.g. MS-DOS) - MALLOCDECL (declared if malloc() etc have - been declared) */ - -#undef const - -#undef MALLOCDECL -#undef NOT_SEGMENTED -#undef HAVE_MEMORY_H -#undef HAVE_COMPLEX_H -#undef HAVE_MALLOC_H -#undef STDC_HEADERS -#undef HAVE_BCOPY -#undef HAVE_BZERO -#undef CHAR0ISDBL0 -#undef WORDS_BIGENDIAN -#undef U_INT_DEF -#undef VARARGS -#undef HAVE_PROTOTYPES -#undef HAVE_PROTOTYPES_IN_STRUCT - -/* for inclusion into C++ files */ -#ifdef __cplusplus -#define ANSI_C 1 -#ifndef HAVE_PROTOTYPES -#define HAVE_PROTOTYPES 1 -#endif -#ifndef HAVE_PROTOTYPES_IN_STRUCT -#define HAVE_PROTOTYPES_IN_STRUCT 1 -#endif -#endif /* __cplusplus */ - -/* example usage: VEC *PROTO(v_get,(int dim)); */ -#ifdef HAVE_PROTOTYPES -#define PROTO(name,args) name args -#else -#define PROTO(name,args) name() -#endif /* HAVE_PROTOTYPES */ -#ifdef HAVE_PROTOTYPES_IN_STRUCT -/* PROTO_() is to be used instead of PROTO() in struct's and typedef's */ -#define PROTO_(name,args) name args -#else -#define PROTO_(name,args) name() -#endif /* HAVE_PROTOTYPES_IN_STRUCT */ - -/* for basic or larger versions */ -#undef COMPLEX -#undef SPARSE - -/* for loop unrolling */ -#undef VUNROLL -#undef MUNROLL - -/* for segmented memory */ -#ifndef NOT_SEGMENTED -#define SEGMENTED -#endif - -/* if the system has malloc.h */ -#ifdef HAVE_MALLOC_H -#define MALLOCDECL 1 -#include <malloc.h> -#endif - -/* any compiler should have this header */ -/* if not, change it */ -#include <stdio.h> - - -/* Check for ANSI C memmove and memset */ -#ifdef STDC_HEADERS - -/* standard copy & zero functions */ -#define MEM_COPY(from,to,size) memmove((to),(from),(size)) -#define MEM_ZERO(where,size) memset((where),'\0',(size)) - -#ifndef ANSI_C -#define ANSI_C 1 -#endif - -#endif - -/* standard headers */ -#ifdef ANSI_C -#include <stdlib.h> -#include <stddef.h> -#include <string.h> -#include <float.h> -#endif - - -/* if have bcopy & bzero and no alternatives yet known, use them */ -#ifdef HAVE_BCOPY -#ifndef MEM_COPY -/* nonstandard copy function */ -#define MEM_COPY(from,to,size) bcopy((char *)(from),(char *)(to),(int)(size)) -#endif -#endif - -#ifdef HAVE_BZERO -#ifndef MEM_ZERO -/* nonstandard zero function */ -#define MEM_ZERO(where,size) bzero((char *)(where),(int)(size)) -#endif -#endif - -/* if the system has complex.h */ -#ifdef HAVE_COMPLEX_H -#include <complex.h> -#endif - -/* If prototypes are available & ANSI_C not yet defined, then define it, - but don't include any header files as the proper ANSI C headers - aren't here */ -#ifdef HAVE_PROTOTYPES -#ifndef ANSI_C -#define ANSI_C 1 -#endif -#endif - -/* floating point precision */ - -/* you can choose single, double or long double (if available) precision */ - -#define FLOAT 1 -#define DOUBLE 2 -#define LONG_DOUBLE 3 - -#undef REAL_FLT -#undef REAL_DBL - -/* if nothing is defined, choose double precision */ -#ifndef REAL_DBL -#ifndef REAL_FLT -#define REAL_DBL 1 -#endif -#endif - -/* single precision */ -#ifdef REAL_FLT -#define Real float -#define LongReal float -#define REAL FLOAT -#define LONGREAL FLOAT -#endif - -/* double precision */ -#ifdef REAL_DBL -#define Real double -#define LongReal double -#define REAL DOUBLE -#define LONGREAL DOUBLE -#endif - - -/* machine epsilon or unit roundoff error */ -/* This is correct on most IEEE Real precision systems */ -#ifdef DBL_EPSILON -#if REAL == DOUBLE -#define MACHEPS DBL_EPSILON -#elif REAL == FLOAT -#define MACHEPS FLT_EPSILON -#elif REAL == LONGDOUBLE -#define MACHEPS LDBL_EPSILON -#endif -#endif - -#undef F_MACHEPS -#undef D_MACHEPS - -#ifndef MACHEPS -#if REAL == DOUBLE -#define MACHEPS D_MACHEPS -#elif REAL == FLOAT -#define MACHEPS F_MACHEPS -#elif REAL == LONGDOUBLE -#define MACHEPS D_MACHEPS -#endif -#endif - -#undef M_MACHEPS - -/******************** -#ifdef DBL_EPSILON -#define MACHEPS DBL_EPSILON -#endif -#ifdef M_MACHEPS -#ifndef MACHEPS -#define MACHEPS M_MACHEPS -#endif -#endif -********************/ - -#undef M_MAX_INT -#ifdef M_MAX_INT -#ifndef MAX_RAND -#define MAX_RAND ((double)(M_MAX_INT)) -#endif -#endif - -/* for non-ANSI systems */ -#ifndef HUGE_VAL -#define HUGE_VAL HUGE -#else -#undef HUGE -#define HUGE HUGE_VAL -#endif - - -#ifdef ANSI_C -extern int isatty(int); -#endif - //GO.SYSIN DD machine.h.in echo copyright 1>&2 sed >copyright <<'//GO.SYSIN DD copyright' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - //GO.SYSIN DD copyright echo tutorial.c 1>&2 sed >tutorial.c <<'//GO.SYSIN DD tutorial.c' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - -/* tutorial.c 10/12/1993 */ - -/* routines from Chapter 1 of Meschach */ - -static char rcsid[] = "$Id: tutorial.c,v 1.3 1994/01/16 22:53:09 des Exp $"; - -#include "matrix.h" - -/* rk4 -- 4th order Runge--Kutta method */ -double rk4(f,t,x,h) -double t, h; -VEC *(*f)(), *x; -{ - static VEC *v1=VNULL, *v2=VNULL, *v3=VNULL, *v4=VNULL; - static VEC *temp=VNULL; - - /* do not work with NULL initial vector */ - if ( x == VNULL ) - error(E_NULL,"rk4"); - - /* ensure that v1, ..., v4, temp are of the correct size */ - v1 = v_resize(v1,x->dim); - v2 = v_resize(v2,x->dim); - v3 = v_resize(v3,x->dim); - v4 = v_resize(v4,x->dim); - temp = v_resize(temp,x->dim); - - /* register workspace variables */ - MEM_STAT_REG(v1,TYPE_VEC); - MEM_STAT_REG(v2,TYPE_VEC); - MEM_STAT_REG(v3,TYPE_VEC); - MEM_STAT_REG(v4,TYPE_VEC); - MEM_STAT_REG(temp,TYPE_VEC); - /* end of memory allocation */ - - (*f)(t,x,v1); /* most compilers allow: "f(t,x,v1);" */ - v_mltadd(x,v1,0.5*h,temp); /* temp = x+.5*h*v1 */ - (*f)(t+0.5*h,temp,v2); - v_mltadd(x,v2,0.5*h,temp); /* temp = x+.5*h*v2 */ - (*f)(t+0.5*h,temp,v3); - v_mltadd(x,v3,h,temp); /* temp = x+h*v3 */ - (*f)(t+h,temp,v4); - - /* now add: v1+2*v2+2*v3+v4 */ - v_copy(v1,temp); /* temp = v1 */ - v_mltadd(temp,v2,2.0,temp); /* temp = v1+2*v2 */ - v_mltadd(temp,v3,2.0,temp); /* temp = v1+2*v2+2*v3 */ - v_add(temp,v4,temp); /* temp = v1+2*v2+2*v3+v4 */ - - /* adjust x */ - v_mltadd(x,temp,h/6.0,x); /* x = x+(h/6)*temp */ - - return t+h; /* return the new time */ -} - - - -/* rk4 -- 4th order Runge-Kutta method */ -/* another variant */ -double rk4_var(f,t,x,h) -double t, h; -VEC *(*f)(), *x; -{ - static VEC *v1, *v2, *v3, *v4, *temp; - - /* do not work with NULL initial vector */ - if ( x == VNULL ) error(E_NULL,"rk4"); - - /* ensure that v1, ..., v4, temp are of the correct size */ - v_resize_vars(x->dim, &v1, &v2, &v3, &v4, &temp, NULL); - - /* register workspace variables */ - mem_stat_reg_vars(0, TYPE_VEC, &v1, &v2, &v3, &v4, &temp, NULL); - /* end of memory allocation */ - - (*f)(t,x,v1); v_mltadd(x,v1,0.5*h,temp); - (*f)(t+0.5*h,temp,v2); v_mltadd(x,v2,0.5*h,temp); - (*f)(t+0.5*h,temp,v3); v_mltadd(x,v3,h,temp); - (*f)(t+h,temp,v4); - - /* now add: temp = v1+2*v2+2*v3+v4 */ - v_linlist(temp, v1, 1.0, v2, 2.0, v3, 2.0, v4, 1.0, VNULL); - /* adjust x */ - v_mltadd(x,temp,h/6.0,x); /* x = x+(h/6)*temp */ - - return t+h; /* return the new time */ -} - - -/* f -- right-hand side of ODE solver */ -VEC *f(t,x,out) -VEC *x, *out; -double t; -{ - if ( x == VNULL || out == VNULL ) - error(E_NULL,"f"); - if ( x->dim != 2 || out->dim != 2 ) - error(E_SIZES,"f"); - - out->ve[0] = x->ve[1]; - out->ve[1] = - x->ve[0]; - - return out; -} - - -void tutor_rk4() -{ - VEC *x; - VEC *f(); - double h, t, t_fin; - double rk4(); - - input("Input initial time: ","%lf",&t); - input("Input final time: ", "%lf",&t_fin); - x = v_get(2); /* this is the size needed by f() */ - prompter("Input initial state:\n"); x = v_input(VNULL); - input("Input step size: ", "%lf",&h); - - printf("# At time %g, the state is\n",t); - v_output(x); - while (t < t_fin) - { - /* you can use t = rk4_var(f,t,x,min(h,t_fin-t)); */ - t = rk4(f,t,x,min(h,t_fin-t)); /* new t is returned */ - printf("# At time %g, the state is\n",t); - v_output(x); - } -} - - - - -#include "matrix2.h" - -void tutor_ls() -{ - MAT *A, *QR; - VEC *b, *x, *diag; - - /* read in A matrix */ - printf("Input A matrix:\n"); - - A = m_input(MNULL); /* A has whatever size is input */ - - if ( A->m < A->n ) - { - printf("Need m >= n to obtain least squares fit\n"); - exit(0); - } - printf("# A =\n"); m_output(A); - diag = v_get(A->m); - /* QR is to be the QR factorisation of A */ - QR = m_copy(A,MNULL); - QRfactor(QR,diag); - /* read in b vector */ - printf("Input b vector:\n"); - b = v_get(A->m); - b = v_input(b); - printf("# b =\n"); v_output(b); - - /* solve for x */ - x = QRsolve(QR,diag,b,VNULL); - printf("Vector of best fit parameters is\n"); - v_output(x); - /* ... and work out norm of errors... */ - printf("||A*x-b|| = %g\n", - v_norm2(v_sub(mv_mlt(A,x,VNULL),b,VNULL))); -} - - -#include <math.h> -#include "iter.h" - - -#define N 50 -#define VEC2MAT(v,m) vm_move((v),0,(m),0,0,N,N); - -#define PI 3.141592653589793116 -#define index(i,j) (N*((i)-1)+(j)-1) - -/* right hand side function (for generating b) */ -double f1(x,y) -double x,y; -{ - /* return 2.0*PI*PI*sin(PI*x)*sin(PI*y); */ - return exp(x*y); -} - -/* discrete laplacian */ -SPMAT *laplacian(A) -SPMAT *A; -{ - Real h; - int i,j; - - if (!A) - A = sp_get(N*N,N*N,5); - - for ( i = 1; i <= N; i++ ) - for ( j = 1; j <= N; j++ ) - { - if ( i < N ) - sp_set_val(A,index(i,j),index(i+1,j),-1.0); - if ( i > 1 ) - sp_set_val(A,index(i,j),index(i-1,j),-1.0); - if ( j < N ) - sp_set_val(A,index(i,j),index(i,j+1),-1.0); - if ( j > 1 ) - sp_set_val(A,index(i,j),index(i,j-1),-1.0); - sp_set_val(A,index(i,j),index(i,j),4.0); - } - return A; -} - -/* generating right hand side */ -VEC *rhs_lap(b) -VEC *b; -{ - Real h,h2,x,y; - int i,j; - - if (!b) - b = v_get(N*N); - - h = 1.0/(N+1); /* for a unit square */ - h2 = h*h; - x = 0.0; - for ( i = 1; i <= N; i++ ) { - x += h; - y = 0.0; - for ( j = 1; j <= N; j++ ) { - y += h; - b->ve[index(i,j)] = h2*f1(x,y); - } - } - return b; -} - -void tut_lap() -{ - SPMAT *A, *LLT; - VEC *b, *out, *x; - MAT *B; - int num_steps; - FILE *fp; - - A = sp_get(N*N,N*N,5); - b = v_get(N*N); - - laplacian(A); - LLT = sp_copy(A); - spICHfactor(LLT); - - out = v_get(A->m); - x = v_get(A->m); - - rhs_lap(b); /* new rhs */ - iter_spcg(A,LLT,b,1e-6,out,1000,&num_steps); - printf("Number of iterations = %d\n",num_steps); - - /* save b as a MATLAB matrix */ - - fp = fopen("laplace.mat","w"); /* b will be saved in laplace.mat */ - if (fp == NULL) { - printf("Cannot open %s\n","laplace.mat"); - exit(1); - } - - /* b must be transformed to a matrix */ - - B = m_get(N,N); - VEC2MAT(out,B); - m_save(fp,B,"sol"); /* sol is an internal name in MATLAB */ - -} - - -void main() -{ - int i; - - input("Choose the problem (1=Runge-Kutta, 2=least squares,3=laplace): ", - "%d",&i); - switch (i) { - case 1: tutor_rk4(); break; - case 2: tutor_ls(); break; - case 3: tut_lap(); break; - default: - printf(" Wrong value of i (only 1, 2 or 3)\n\n"); - break; - } - -} - //GO.SYSIN DD tutorial.c echo tutadv.c 1>&2 sed >tutadv.c <<'//GO.SYSIN DD tutadv.c' 's/^-//' - -/* routines from the section 8 of tutorial.txt */ - -#include "matrix.h" - -#define M3D_LIST 3 /* list number */ -#define TYPE_MAT3D 0 /* the number of a type */ - -/* type for 3 dimensional matrices */ -typedef struct { - int l,m,n; /* actual dimensions */ - int max_l, max_m, max_n; /* maximal dimensions */ - Real ***me; /* pointer to matrix elements */ - /* we do not consider segmented memory */ - Real *base, **me2d; /* me and me2d are additional pointers - to base */ -} MAT3D; - - -/* function for creating a variable of MAT3D type */ - -MAT3D *m3d_get(l,m,n) -int l,m,n; -{ - MAT3D *mat; - int i,j,k; - - /* check if arguments are positive */ - if (l <= 0 || m <= 0 || n <= 0) - error(E_NEG,"m3d_get"); - - /* new structure */ - if ((mat = NEW(MAT3D)) == (MAT3D *)NULL) - error(E_MEM,"m3d_get"); - else if (mem_info_is_on()) { - /* record how many bytes is allocated */ - mem_bytes_list(TYPE_MAT3D,0,sizeof(MAT3D),M3D_LIST); - /* record a new allocated variable */ - mem_numvar_list(TYPE_MAT3D,1,M3D_LIST); - } - - mat->l = mat->max_l = l; - mat->m = mat->max_m = m; - mat->n = mat->max_n = n; - - /* allocate memory for 3D array */ - if ((mat->base = NEW_A(l*m*n,Real)) == (Real *)NULL) - error(E_MEM,"m3d_get"); - else if (mem_info_is_on()) - mem_bytes_list(TYPE_MAT3D,0,l*m*n*sizeof(Real),M3D_LIST); - - /* allocate memory for 2D pointers */ - if ((mat->me2d = NEW_A(l*m,Real *)) == (Real **)NULL) - error(E_MEM,"m3d_get"); - else if (mem_info_is_on()) - mem_bytes_list(TYPE_MAT3D,0,l*m*sizeof(Real *),M3D_LIST); - - /* allocate memory for 1D pointers */ - if ((mat->me = NEW_A(l,Real **)) == (Real ***)NULL) - error(E_MEM,"m3d_get"); - else if (mem_info_is_on()) - mem_bytes_list(TYPE_MAT3D,0,l*sizeof(Real **),M3D_LIST); - - /* pointers to 2D matrices */ - for (i=0,k=0; i < l; i++) - for (j=0; j < m; j++) - mat->me2d[k++] = &mat->base[(i*m+j)*n]; - - /* pointers to rows */ - for (i=0; i < l; i++) - mat->me[i] = &mat->me2d[i*m]; - - return mat; -} - - -/* deallocate a variable of type MAT3D */ - -int m3d_free(mat) -MAT3D *mat; -{ - /* do not try to deallocate the NULL pointer */ - if (mat == (MAT3D *)NULL) - return -1; - - /* first deallocate base */ - if (mat->base != (Real *)NULL) { - if (mem_info_is_on()) - /* record how many bytes is deallocated */ - mem_bytes_list(TYPE_MAT3D,mat->max_l*mat->max_m*mat->max_n*sizeof(Real), - 0,M3D_LIST); - free((char *)mat->base); - } - - /* deallocate array of 2D pointers */ - if (mat->me2d != (Real **)NULL) { - if (mem_info_is_on()) - /* record how many bytes is deallocated */ - mem_bytes_list(TYPE_MAT3D,mat->max_l*mat->max_m*sizeof(Real *), - 0,M3D_LIST); - free((char *)mat->me2d); - } - - /* deallocate array of 1D pointers */ - if (mat->me != (Real ***)NULL) { - if (mem_info_is_on()) - /* record how many bytes is deallocated */ - mem_bytes_list(TYPE_MAT3D,mat->max_l*sizeof(Real **),0,M3D_LIST); - free((char *)mat->me); - } - - /* deallocate MAT3D structure */ - if (mem_info_is_on()) { - mem_bytes_list(TYPE_MAT3D,sizeof(MAT3D),0,M3D_LIST); - mem_numvar_list(TYPE_MAT3D,-1,M3D_LIST); - } - free((char *)mat); - - return 0; -} - -/*=============================================*/ - -char *m3d_names[] = { - "MAT3D" -}; - - -#define M3D_NUM (sizeof(m3d_names)/sizeof(*m3d_names)) - -int (*m3d_free_funcs[M3D_NUM])() = { - m3d_free -}; - -static MEM_ARRAY m3d_sum[M3D_NUM]; - - -/* test routing for allocating/deallocating static variables */ -void test_stat(k) -int k; -{ - static MAT3D *work; - - if (!work) { - work = m3d_get(10,10,10); - mem_stat_reg_list(&work,TYPE_MAT3D,M3D_LIST); - work->me[9][9][9] = -3.14; - } - - if (k == 9) - printf(" work[9][9][9] = %g\n",work->me[9][9][9]); -} - - -void main() -{ - MAT3D *M; - int i,j,k; - - mem_info_on(TRUE); - /* can be the first command */ - mem_attach_list(M3D_LIST,M3D_NUM,m3d_names,m3d_free_funcs,m3d_sum); - - M = m3d_get(3,4,5); - mem_info_file(stdout,M3D_LIST); - - /* make use of M->me[i][j][k], where i,j,k are non-negative and - i < 3, j < 4, k < 5 */ - - mem_stat_mark(1); - for (i=0; i < 3; i++) - for (j=0; j < 4; j++) - for (k=0; k < 5; k++) { - test_stat(i+j+k); - M->me[i][j][k] = i+j+k; - } - mem_stat_free_list(1,M3D_LIST); - mem_info_file(stdout,M3D_LIST); - - printf(" M[%d][%d][%d] = %g\n",2,3,4,M->me[2][3][4]); - - mem_stat_mark(2); - test_stat(9); - mem_stat_free_list(2,M3D_LIST); - - m3d_free(M); /* if M is not necessary */ - mem_info_file(stdout,M3D_LIST); - -} - - - //GO.SYSIN DD tutadv.c echo rk4.dat 1>&2 sed >rk4.dat <<'//GO.SYSIN DD rk4.dat' 's/^-//' -# No. of a problem -1 -# Initial time -0 -# Final time -1 -# Solution is x(t) = (cos(t),-sin(t)) -# x(0) = -Vector: dim: 2 -1 0 -# Step size -0.1 //GO.SYSIN DD rk4.dat echo ls.dat 1>&2 sed >ls.dat <<'//GO.SYSIN DD ls.dat' 's/^-//' -# No. of a problem -2 -# A = -Matrix: 5 by 3 -row 0: 3 -1 2 -row 1: 2 -1 1.2 -row 2: 2.5 1 -1.5 -row 3: 3 1 1 -row 4: -1 1 -2.2 - -# b = -Vector: dim: 5 - 5 3 2 4 6 - //GO.SYSIN DD ls.dat echo makefile 1>&2 sed >makefile <<'//GO.SYSIN DD makefile' 's/^-//' -# Generated automatically from makefile.in by configure. -# -# Makefile for Meschach via autoconf -# -# Copyright (C) David Stewart & Zbigniew Leyk 1993 -# -# $Id: $ -# - -srcdir = . -VPATH = . - -CC = cc - -DEFS = -DHAVE_CONFIG_H -LIBS = -lm -RANLIB = ranlib - - -CFLAGS = -O - - -.c.o: - $(CC) -c $(CFLAGS) $(DEFS) $< - -SHELL = /bin/sh -MES_PAK = mesch12b -TAR = tar -SHAR = stree -u -ZIP = zip -r -l -FLIST = FILELIST - -############################### - -LIST1 = copy.o err.o matrixio.o memory.o vecop.o matop.o pxop.o \ - submat.o init.o otherio.o machine.o matlab.o ivecop.o version.o \ - meminfo.o memstat.o -LIST2 = lufactor.o bkpfacto.o chfactor.o qrfactor.o solve.o hsehldr.o \ - givens.o update.o norm.o hessen.o symmeig.o schur.o svd.o fft.o \ - mfunc.o bdfactor.o -LIST3 = sparse.o sprow.o sparseio.o spchfctr.o splufctr.o \ - spbkp.o spswap.o iter0.o itersym.o iternsym.o -ZLIST1 = zmachine.o zcopy.o zmatio.o zmemory.o zvecop.o zmatop.o znorm.o \ - zfunc.o -ZLIST2 = zlufctr.o zsolve.o zmatlab.o zhsehldr.o zqrfctr.o \ - zgivens.o zhessen.o zschur.o - -# they are no longer supported -# if you use them add oldpart to all and sparse -OLDLIST = conjgrad.o lanczos.o arnoldi.o - -ALL_LISTS = $(LIST1) $(LIST2) $(LIST3) $(ZLIST1) $(ZLIST2) $(OLDLIST) - -HBASE = err.h meminfo.h machine.h matrix.h - -HLIST = $(HBASE) iter.h matlab.h matrix2.h oldnames.h sparse.h \ - sparse2.h zmatrix.h zmatrix2.h - -TORTURE = torture.o sptort.o ztorture.o memtort.o itertort.o \ - mfuntort.o iotort.o - -OTHERS = dmacheps.c extras.c fmacheps.c maxint.c makefile.in \ - README configure configure.in machine.h.in copyright \ - tutorial.c tutadv.c rk4.dat ls.dat makefile $(FLIST) - - -# Different configurations -# the dependencies **between** the parts are for dmake -all: part1 part2 part3 zpart1 zpart2 -part2: part1 -part3: part2 -basic: part1 part2 -sparse: part1 part2 part3 -zpart2: zpart1 -complex: part1 part2 zpart1 zpart2 - - -$(LIST1): $(HBASE) -part1: $(LIST1) - ar ru meschach.a $(LIST1); $(RANLIB) meschach.a - -$(LIST2): $(HBASE) matrix2.h -part2: $(LIST2) - ar ru meschach.a $(LIST2); $(RANLIB) meschach.a - -$(LIST3): $(HBASE) sparse.h sparse2.h -part3: $(LIST3) - ar ru meschach.a $(LIST3); $(RANLIB) meschach.a - -$(ZLIST1): $(HBASDE) zmatrix.h -zpart1: $(ZLIST1) - ar ru meschach.a $(ZLIST1); $(RANLIB) meschach.a - -$(ZLIST2): $(HBASE) zmatrix.h zmatrix2.h -zpart2: $(ZLIST2) - ar ru meschach.a $(ZLIST2); $(RANLIB) meschach.a - -$(OLDLIST): $(HBASE) sparse.h sparse2.h -oldpart: $(OLDLIST) - ar ru meschach.a $(OLDLIST); $(RANLIB) meschach.a - - - -####################################### - -tar: - - /bin/rm -f $(MES_PAK).tar - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(TAR) cvf $(MES_PAK).tar \ - `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) \ - `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC - -# use this only for PC machines -msdos-zip: - - /bin/rm -f $(MES_PAK).zip - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(ZIP) $(MES_PAK).zip \ - `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC - - -fullshar: - - /bin/rm -f $(MES_PAK).shar; - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(SHAR) `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC > $(MES_PAK).shar - -shar: - - /bin/rm -f meschach1.shar meschach2.shar meschach3.shar \ - meschach4.shar oldmeschach.shar meschach0.shar - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(SHAR) `echo $(LIST1) | sed -e 's/\.o/.c/g'` > meschach1.shar - $(SHAR) `echo $(LIST2) | sed -e 's/\.o/.c/g'` > meschach2.shar - $(SHAR) `echo $(LIST3) | sed -e 's/\.o/.c/g'` > meschach3.shar - $(SHAR) `echo $(ZLIST1) | sed -e 's/\.o/.c/g'` \ - `echo $(ZLIST2) | sed -e 's/\.o/.c/g'` > meschach4.shar - $(SHAR) `echo $(OLDLIST) | sed -e 's/\.o/.c/g'` > oldmeschach.shar - $(SHAR) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - $(HLIST) DOC MACHINES > meschach0.shar - -list: - /bin/rm -f $(FLIST) - ls -lR `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) MACHINES DOC \ - |awk '/^$$/ {print};/^[-d]/ {printf("%s %s %10d %s %s %s %s\n", \ - $$1,$$2,$$5,$$6,$$7,$$8,$$9)}; /^[^-d]/ {print}' \ - > $(FLIST) - - - -clean: - /bin/rm -f *.o core asx5213a.mat iotort.dat - -cleanup: - /bin/rm -f *.o core asx5213a.mat iotort.dat *.a - -realclean: - /bin/rm -f *.o core asx5213a.mat iotort.dat *.a - /bin/rm -f torture sptort ztorture memtort itertort mfuntort iotort - /bin/rm -f makefile machine.h config.status maxint macheps - -alltorture: torture sptort ztorture memtort itertort mfuntort iotort - -torture:torture.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o torture torture.o \ - meschach.a $(LIBS) -sptort:sptort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o sptort sptort.o \ - meschach.a $(LIBS) -memtort: memtort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o memtort memtort.o \ - meschach.a $(LIBS) -ztorture:ztorture.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o ztorture ztorture.o \ - meschach.a $(LIBS) -itertort: itertort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o itertort itertort.o \ - meschach.a $(LIBS) - -iotort: iotort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o iotort iotort.o \ - meschach.a $(LIBS) -mfuntort: mfuntort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o mfuntort mfuntort.o \ - meschach.a $(LIBS) -tstmove: tstmove.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o tstmove tstmove.o \ - meschach.a $(LIBS) -tstpxvec: tstpxvec.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o tstpxvec tstpxvec.o \ - meschach.a $(LIBS) - //GO.SYSIN DD makefile echo FILELIST 1>&2 sed >FILELIST <<'//GO.SYSIN DD FILELIST' 's/^-//' --rw-r----- 1 0 May 18 11:56 FILELIST --rw-r--r-- 1 18006 Apr 06 11:56 README --rw-r--r-- 1 4844 Jan 13 16:45 arnoldi.c --rw-r--r-- 1 13380 May 18 09:20 bdfactor.c --rw-r--r-- 1 8450 Jan 13 16:45 bkpfacto.c --rw-r--r-- 1 5022 Jan 13 16:36 chfactor.c --rwxr-xr-x 1 26888 Mar 08 14:54 configure --rw-r--r-- 1 3536 Mar 08 15:42 configure.in --rw-r--r-- 1 8250 Jan 13 16:36 conjgrad.c --rw-r--r-- 1 5530 Jan 13 16:37 copy.c --rw-r--r-- 1 1124 Jan 13 16:54 copyright --rw-r--r-- 1 1402 Jan 13 16:37 dmacheps.c --rw-r--r-- 1 9756 Jan 13 16:38 err.c --rw-r--r-- 1 5678 Jan 13 16:38 err.h --rw-r--r-- 1 10923 Jan 13 16:45 extras.c --rw-r--r-- 1 3892 Jan 13 16:45 fft.c --rw-r--r-- 1 1400 Jan 13 16:39 fmacheps.c --rw-r--r-- 1 3603 Jan 13 16:39 givens.c --rw-r--r-- 1 4063 Jan 13 16:36 hessen.c --rw-r--r-- 1 4735 Jan 13 16:36 hsehldr.c --rw-r--r-- 1 5889 Jan 13 16:37 init.c --rw-r--r-- 1 3396 Jan 14 11:46 iotort.c --rw-r--r-- 1 6911 Mar 08 15:49 iter.h --rw-r--r-- 1 8878 Jan 13 16:38 iter0.c --rw-r--r-- 1 30104 Feb 02 17:03 iternsym.c --rw-r--r-- 1 13826 Jan 13 16:39 itersym.c --rw-r--r-- 1 16178 Jan 14 11:46 itertort.c --rw-r--r-- 1 9800 Jan 13 16:45 ivecop.c --rw-r--r-- 1 7733 Jan 13 16:28 lanczos.c --rw-r--r-- 1 397 Jan 13 16:49 ls.dat --rw-r--r-- 1 6594 Mar 14 09:09 lufactor.c --rw-r--r-- 1 3669 Jan 25 09:39 machine.c --rw-r--r-- 1 4526 Mar 08 14:55 machine.h --rw-r--r-- 1 4429 Mar 14 09:08 machine.h.in --rw-r--r-- 1 5891 Mar 14 11:23 makefile --rw-r--r-- 1 5898 Mar 14 11:24 makefile.in --rw-r--r-- 1 5063 Jan 13 16:30 matlab.c --rw-r--r-- 1 2998 Jan 13 16:45 matlab.h --rw-r--r-- 1 12014 Jan 13 16:30 matop.c --rw-r--r-- 1 19232 Apr 16 10:35 matrix.h --rw-r--r-- 1 8291 Jan 13 16:31 matrix2.h --rw-r--r-- 1 13409 Jan 13 16:31 matrixio.c --rw-r--r-- 1 1257 Jan 13 16:31 maxint.c --rw-r--r-- 1 9155 Jan 13 16:32 meminfo.c --rw-r--r-- 1 4148 Jan 13 16:32 meminfo.h --rw-r--r-- 1 19918 Apr 05 12:13 memory.c --rw-r--r-- 1 8644 Jan 13 16:33 memstat.c --rw-r--r-- 1 17345 Jan 14 11:46 memtort.c --rw-r--r-- 1 9018 Jan 13 16:34 mfunc.c --rw-r--r-- 1 4533 Jan 14 12:08 mfuntort.c --rw-r--r-- 1 4187 Jan 13 16:34 norm.c --rw-r--r-- 1 3853 Jan 13 16:34 oldnames.h --rw-r--r-- 1 4226 Jan 13 16:35 otherio.c --rw-r--r-- 1 7497 Mar 24 09:59 pxop.c --rw-r--r-- 1 13381 Jan 13 16:35 qrfactor.c --rw-r--r-- 1 141 Jan 13 16:49 rk4.dat --rw-r--r-- 1 18439 Mar 17 15:38 schur.c --rw-r--r-- 1 6553 Jan 13 16:30 solve.c --rw-r--r-- 1 23765 Mar 08 15:47 sparse.c --rw-r--r-- 1 6483 Jan 13 16:33 sparse.h --rw-r--r-- 1 3160 Jan 13 16:33 sparse2.h --rw-r--r-- 1 8225 Jan 13 16:34 sparseio.c --rw-r--r-- 1 35604 Jan 13 16:44 spbkp.c --rw-r--r-- 1 15913 Jan 13 16:31 spchfctr.c --rw-r--r-- 1 10808 May 10 09:14 splufctr.c --rw-r--r-- 1 17667 Jan 13 16:35 sprow.c --rw-r--r-- 1 7408 Jan 13 16:44 spswap.c --rw-r--r-- 1 11286 Mar 01 10:22 sptort.c --rw-r--r-- 1 4533 Jan 13 16:28 submat.c --rw-r--r-- 1 9917 Jan 13 16:44 svd.c --rw-r--r-- 1 5967 Feb 16 14:25 symmeig.c --rw-r--r-- 1 28139 May 18 11:54 torture.c --rw-r--r-- 1 4499 Jan 14 14:43 tutadv.c --rw-r--r-- 1 7767 Jan 17 09:53 tutorial.c --rw-r--r-- 1 3441 Jan 13 16:26 update.c --rw-r--r-- 1 13430 Mar 08 15:50 vecop.c --rw-r--r-- 1 2562 Mar 24 10:07 version.c --rw-r--r-- 1 5204 Jan 13 15:28 zcopy.c --rw-r--r-- 1 4411 Jan 13 15:28 zfunc.c --rw-r--r-- 1 4801 Mar 08 14:31 zgivens.c --rw-r--r-- 1 3948 Jan 13 15:27 zhessen.c --rw-r--r-- 1 5532 Apr 07 11:44 zhsehldr.c --rw-r--r-- 1 6892 Jan 13 15:26 zlufctr.c --rw-r--r-- 1 4255 Jan 13 15:26 zmachine.c --rw-r--r-- 1 10649 Jan 13 15:25 zmatio.c --rw-r--r-- 1 5845 Jan 13 15:25 zmatlab.c --rw-r--r-- 1 15253 Jan 13 15:24 zmatop.c --rw-r--r-- 1 8782 Mar 08 15:50 zmatrix.h --rw-r--r-- 1 4151 Jan 13 15:24 zmatrix2.h --rw-r--r-- 1 15275 Apr 05 12:13 zmemory.c --rw-r--r-- 1 4624 Jan 13 15:21 znorm.c --rw-r--r-- 1 13780 Jan 13 15:21 zqrfctr.c --rw-r--r-- 1 10977 Jan 13 15:21 zschur.c --rw-r--r-- 1 7573 Jan 13 15:20 zsolve.c --rw-r--r-- 1 20049 Apr 12 12:29 ztorture.c --rw-r--r-- 1 11225 Mar 08 15:51 zvecop.c - -DOC: -total 136 --rw-r----- 1 17186 Jan 14 12:01 fnindex.txt --rw-r----- 1 45980 Jan 14 12:01 tutorial.txt - -MACHINES: -total 32 -drwxr-s--- 2 512 Jan 14 14:24 GCC -drwxr-s--- 2 512 Mar 03 09:52 Linux -drwxr-s--- 2 512 Feb 14 12:08 RS6000 -drwxr-s--- 2 512 Jan 14 14:24 SPARC - -MACHINES/GCC: -total 24 --rw-r----- 1 3775 Jan 14 14:24 machine.h --rw-r----- 1 5183 Jan 14 14:24 makefile - -MACHINES/Linux: -total 24 --rw-r----- 1 3820 Mar 03 09:52 machine.h --rw-r----- 1 5595 Mar 03 09:52 makefile - -MACHINES/RS6000: -total 40 --rw-r----- 1 6129 Jan 25 09:39 machine.c --rw-r----- 1 3502 Jan 14 14:24 machine.h --rw-r----- 1 5654 Feb 14 12:07 makefile - -MACHINES/SPARC: -total 24 --rw-r----- 1 3524 Jan 14 14:24 machine.h --rw-r----- 1 5186 Jan 14 14:24 makefile //GO.SYSIN DD FILELIST echo torture.c 1>&2 sed >torture.c <<'//GO.SYSIN DD torture.c' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - -/* - This file contains a series of tests for the Meschach matrix - library, parts 1 and 2 -*/ - -static char rcsid[] = "$Id: torture.c,v 1.5 1994/05/18 01:53:58 des Exp $"; - -#include <stdio.h> -#include <math.h> -#include "matrix2.h" -#include "matlab.h" - -#define errmesg(mesg) printf("Error: %s error: line %d\n",mesg,__LINE__) -#define notice(mesg) printf("# Testing %s...\n",mesg); - -static char *test_err_list[] = { - "unknown error", /* 0 */ - "testing error messages", /* 1 */ - "unexpected end-of-file" /* 2 */ -}; - - -#define MAX_TEST_ERR (sizeof(test_err_list)/sizeof(char *)) - -/* extern int malloc_chain_check(); */ -/* #define MEMCHK() if ( malloc_chain_check(0) ) \ -{ printf("Error in malloc chain: \"%s\", line %d\n", \ - __FILE__, __LINE__); exit(0); } */ -#define MEMCHK() - -/* cmp_perm -- returns 1 if pi1 == pi2, 0 otherwise */ -int cmp_perm(pi1, pi2) -PERM *pi1, *pi2; -{ - int i; - - if ( ! pi1 || ! pi2 ) - error(E_NULL,"cmp_perm"); - if ( pi1->size != pi2->size ) - return 0; - for ( i = 0; i < pi1->size; i++ ) - if ( pi1->pe[i] != pi2->pe[i] ) - return 0; - return 1; -} - -/* px_rand -- generates sort-of random permutation */ -PERM *px_rand(pi) -PERM *pi; -{ - int i, j, k; - - if ( ! pi ) - error(E_NULL,"px_rand"); - - for ( i = 0; i < 3*pi->size; i++ ) - { - j = (rand() >> 8) % pi->size; - k = (rand() >> 8) % pi->size; - px_transp(pi,j,k); - } - - return pi; -} - -#define SAVE_FILE "asx5213a.mat" -#define MATLAB_NAME "alpha" -char name[81] = MATLAB_NAME; - -int main(argc, argv) -int argc; -char *argv[]; -{ - VEC *x = VNULL, *y = VNULL, *z = VNULL, *u = VNULL, *v = VNULL, - *w = VNULL; - VEC *diag = VNULL, *beta = VNULL; - PERM *pi1 = PNULL, *pi2 = PNULL, *pi3 = PNULL, *pivot = PNULL, - *blocks = PNULL; - MAT *A = MNULL, *Atmp = MNULL, *B = MNULL, *C = MNULL, *D = MNULL, - *Q = MNULL, *Qtmp = MNULL, *U = MNULL; - BAND *bA, *bB, *bC; - Real cond_est, s1, s2, s3; - int i, j, seed; - FILE *fp; - char *cp; - - - mem_info_on(TRUE); - - setbuf(stdout,(char *)NULL); - - seed = 1111; - if ( argc > 2 ) - { - printf("usage: %s [seed]\n",argv[0]); - exit(0); - } - else if ( argc == 2 ) - sscanf(argv[1], "%d", &seed); - - /* set seed for rand() */ - smrand(seed); - - mem_stat_mark(1); - - /* print version information */ - m_version(); - - printf("# grep \"^Error\" the output for a listing of errors\n"); - printf("# Don't panic if you see \"Error\" appearing; \n"); - printf("# Also check the reported size of error\n"); - printf("# This program uses randomly generated problems and therefore\n"); - printf("# may occasionally produce ill-conditioned problems\n"); - printf("# Therefore check the size of the error compared with MACHEPS\n"); - printf("# If the error is within 1000*MACHEPS then don't worry\n"); - printf("# If you get an error of size 0.1 or larger there is \n"); - printf("# probably a bug in the code or the compilation procedure\n\n"); - printf("# seed = %d\n",seed); - - printf("# Check: MACHEPS = %g\n",MACHEPS); - /* allocate, initialise, copy and resize operations */ - /* VEC */ - notice("vector initialise, copy & resize"); - x = v_get(12); - y = v_get(15); - z = v_get(12); - v_rand(x); - v_rand(y); - z = v_copy(x,z); - if ( v_norm2(v_sub(x,z,z)) >= MACHEPS ) - errmesg("VEC copy"); - v_copy(x,y); - x = v_resize(x,10); - y = v_resize(y,10); - if ( v_norm2(v_sub(x,y,z)) >= MACHEPS ) - errmesg("VEC copy/resize"); - x = v_resize(x,15); - y = v_resize(y,15); - if ( v_norm2(v_sub(x,y,z)) >= MACHEPS ) - errmesg("VEC resize"); - - /* MAT */ - notice("matrix initialise, copy & resize"); - A = m_get(8,5); - B = m_get(3,9); - C = m_get(8,5); - m_rand(A); - m_rand(B); - C = m_copy(A,C); - if ( m_norm_inf(m_sub(A,C,C)) >= MACHEPS ) - errmesg("MAT copy"); - m_copy(A,B); - A = m_resize(A,3,5); - B = m_resize(B,3,5); - if ( m_norm_inf(m_sub(A,B,C)) >= MACHEPS ) - errmesg("MAT copy/resize"); - A = m_resize(A,10,10); - B = m_resize(B,10,10); - if ( m_norm_inf(m_sub(A,B,C)) >= MACHEPS ) - errmesg("MAT resize"); - - MEMCHK(); - - /* PERM */ - notice("permutation initialise, inverting & permuting vectors"); - pi1 = px_get(15); - pi2 = px_get(12); - px_rand(pi1); - v_rand(x); - px_vec(pi1,x,z); - y = v_resize(y,x->dim); - pxinv_vec(pi1,z,y); - if ( v_norm2(v_sub(x,y,z)) >= MACHEPS ) - errmesg("PERMute vector"); - pi2 = px_inv(pi1,pi2); - pi3 = px_mlt(pi1,pi2,PNULL); - for ( i = 0; i < pi3->size; i++ ) - if ( pi3->pe[i] != i ) - errmesg("PERM inverse/multiply"); - - /* testing catch() etc */ - notice("error handling routines"); - catch(E_NULL, - catchall(v_add(VNULL,VNULL,VNULL); - errmesg("tracecatch() failure"), - printf("# tracecatch() caught error\n"); - error(E_NULL,"main")); - errmesg("catch() failure"), - printf("# catch() caught E_NULL error\n")); - - /* testing attaching a new error list (error list 2) */ - - notice("attaching error lists"); - printf("# IT IS NOT A REAL WARNING ... \n"); - err_list_attach(2,MAX_TEST_ERR,test_err_list,TRUE); - if (!err_is_list_attached(2)) - errmesg("attaching the error list 2"); - ev_err(__FILE__,1,__LINE__,"main",2); - err_list_free(2); - if (err_is_list_attached(2)) - errmesg("detaching the error list 2"); - - /* testing inner products and v_mltadd() etc */ - notice("inner products and linear combinations"); - u = v_get(x->dim); - v_rand(u); - v_rand(x); - v_resize(y,x->dim); - v_rand(y); - v_mltadd(y,x,-in_prod(x,y)/in_prod(x,x),z); - if ( fabs(in_prod(x,z)) >= MACHEPS*x->dim ) - errmesg("v_mltadd()/in_prod()"); - s1 = -in_prod(x,y)/(v_norm2(x)*v_norm2(x)); - sv_mlt(s1,x,u); - v_add(y,u,u); - if ( v_norm2(v_sub(u,z,u)) >= MACHEPS*x->dim ) - errmesg("sv_mlt()/v_norm2()"); - -#ifdef ANSI_C - v_linlist(u,x,s1,y,1.0,VNULL); - if ( v_norm2(v_sub(u,z,u)) >= MACHEPS*x->dim ) - errmesg("v_linlist()"); -#endif -#ifdef VARARGS - v_linlist(u,x,s1,y,1.0,VNULL); - if ( v_norm2(v_sub(u,z,u)) >= MACHEPS*x->dim ) - errmesg("v_linlist()"); -#endif - - - MEMCHK(); - - /* vector norms */ - notice("vector norms"); - x = v_resize(x,12); - v_rand(x); - for ( i = 0; i < x->dim; i++ ) - if ( v_entry(x,i) >= 0.5 ) - v_set_val(x,i,1.0); - else - v_set_val(x,i,-1.0); - s1 = v_norm1(x); - s2 = v_norm2(x); - s3 = v_norm_inf(x); - if ( fabs(s1 - x->dim) >= MACHEPS*x->dim || - fabs(s2 - sqrt((Real)(x->dim))) >= MACHEPS*x->dim || - fabs(s3 - 1.0) >= MACHEPS ) - errmesg("v_norm1/2/_inf()"); - - /* test matrix multiply etc */ - notice("matrix multiply and invert"); - A = m_resize(A,10,10); - B = m_resize(B,10,10); - m_rand(A); - m_inverse(A,B); - m_mlt(A,B,C); - for ( i = 0; i < C->m; i++ ) - m_set_val(C,i,i,m_entry(C,i,i)-1.0); - if ( m_norm_inf(C) >= MACHEPS*m_norm_inf(A)*m_norm_inf(B)*5 ) - errmesg("m_inverse()/m_mlt()"); - - MEMCHK(); - - /* ... and transposes */ - notice("transposes and transpose-multiplies"); - m_transp(A,A); /* can do square matrices in situ */ - mtrm_mlt(A,B,C); - for ( i = 0; i < C->m; i++ ) - m_set_val(C,i,i,m_entry(C,i,i)-1.0); - if ( m_norm_inf(C) >= MACHEPS*m_norm_inf(A)*m_norm_inf(B)*5 ) - errmesg("m_transp()/mtrm_mlt()"); - m_transp(A,A); - m_transp(B,B); - mmtr_mlt(A,B,C); - for ( i = 0; i < C->m; i++ ) - m_set_val(C,i,i,m_entry(C,i,i)-1.0); - if ( m_norm_inf(C) >= MACHEPS*m_norm_inf(A)*m_norm_inf(B)*5 ) - errmesg("m_transp()/mmtr_mlt()"); - sm_mlt(3.71,B,B); - mmtr_mlt(A,B,C); - for ( i = 0; i < C->m; i++ ) - m_set_val(C,i,i,m_entry(C,i,i)-3.71); - if ( m_norm_inf(C) >= MACHEPS*m_norm_inf(A)*m_norm_inf(B)*5 ) - errmesg("sm_mlt()/mmtr_mlt()"); - m_transp(B,B); - sm_mlt(1.0/3.71,B,B); - - MEMCHK(); - - /* ... and matrix-vector multiplies */ - notice("matrix-vector multiplies"); - x = v_resize(x,A->n); - y = v_resize(y,A->m); - z = v_resize(z,A->m); - u = v_resize(u,A->n); - v_rand(x); - v_rand(y); - mv_mlt(A,x,z); - s1 = in_prod(y,z); - vm_mlt(A,y,u); - s2 = in_prod(u,x); - if ( fabs(s1 - s2) >= (MACHEPS*x->dim)*x->dim ) - errmesg("mv_mlt()/vm_mlt()"); - mv_mlt(B,z,u); - if ( v_norm2(v_sub(u,x,u)) >= MACHEPS*m_norm_inf(A)*m_norm_inf(B)*5 ) - errmesg("mv_mlt()/m_inverse()"); - - MEMCHK(); - - /* get/set row/col */ - notice("getting and setting rows and cols"); - x = v_resize(x,A->n); - y = v_resize(y,B->m); - x = get_row(A,3,x); - y = get_col(B,3,y); - if ( fabs(in_prod(x,y) - 1.0) >= MACHEPS*m_norm_inf(A)*m_norm_inf(B)*5 ) - errmesg("get_row()/get_col()"); - sv_mlt(-1.0,x,x); - sv_mlt(-1.0,y,y); - set_row(A,3,x); - set_col(B,3,y); - m_mlt(A,B,C); - for ( i = 0; i < C->m; i++ ) - m_set_val(C,i,i,m_entry(C,i,i)-1.0); - if ( m_norm_inf(C) >= MACHEPS*m_norm_inf(A)*m_norm_inf(B)*5 ) - errmesg("set_row()/set_col()"); - - MEMCHK(); - - /* matrix norms */ - notice("matrix norms"); - A = m_resize(A,11,15); - m_rand(A); - s1 = m_norm_inf(A); - B = m_transp(A,B); - s2 = m_norm1(B); - if ( fabs(s1 - s2) >= MACHEPS*A->m ) - errmesg("m_norm1()/m_norm_inf()"); - C = mtrm_mlt(A,A,C); - s1 = 0.0; - for ( i = 0; i < C->m && i < C->n; i++ ) - s1 += m_entry(C,i,i); - if ( fabs(sqrt(s1) - m_norm_frob(A)) >= MACHEPS*A->m*A->n ) - errmesg("m_norm_frob"); - - MEMCHK(); - - /* permuting rows and columns */ - notice("permuting rows & cols"); - A = m_resize(A,11,15); - B = m_resize(B,11,15); - pi1 = px_resize(pi1,A->m); - px_rand(pi1); - x = v_resize(x,A->n); - y = mv_mlt(A,x,y); - px_rows(pi1,A,B); - px_vec(pi1,y,z); - mv_mlt(B,x,u); - if ( v_norm2(v_sub(z,u,u)) >= MACHEPS*A->m ) - errmesg("px_rows()"); - pi1 = px_resize(pi1,A->n); - px_rand(pi1); - px_cols(pi1,A,B); - pxinv_vec(pi1,x,z); - mv_mlt(B,z,u); - if ( v_norm2(v_sub(y,u,u)) >= MACHEPS*A->n ) - errmesg("px_cols()"); - - MEMCHK(); - - /* MATLAB save/load */ - notice("MATLAB save/load"); - A = m_resize(A,12,11); - if ( (fp=fopen(SAVE_FILE,"w")) == (FILE *)NULL ) - printf("Cannot perform MATLAB save/load test\n"); - else - { - m_rand(A); - m_save(fp, A, name); - fclose(fp); - if ( (fp=fopen(SAVE_FILE,"r")) == (FILE *)NULL ) - printf("Cannot open save file \"%s\"\n",SAVE_FILE); - else - { - M_FREE(B); - B = m_load(fp,&cp); - if ( strcmp(name,cp) || m_norm1(m_sub(A,B,B)) >= MACHEPS*A->m ) - errmesg("mload()/m_save()"); - } - } - - MEMCHK(); - - /* Now, onto matrix factorisations */ - A = m_resize(A,10,10); - B = m_resize(B,A->m,A->n); - m_copy(A,B); - x = v_resize(x,A->n); - y = v_resize(y,A->m); - z = v_resize(z,A->n); - u = v_resize(u,A->m); - v_rand(x); - mv_mlt(B,x,y); - z = v_copy(x,z); - - notice("LU factor/solve"); - pivot = px_get(A->m); - LUfactor(A,pivot); - tracecatch(LUsolve(A,pivot,y,x),"main"); - tracecatch(cond_est = LUcondest(A,pivot),"main"); - printf("# cond(A) approx= %g\n", cond_est); - if ( v_norm2(v_sub(x,z,u)) >= MACHEPS*v_norm2(x)*cond_est) - { - errmesg("LUfactor()/LUsolve()"); - printf("# LU solution error = %g [cf MACHEPS = %g]\n", - v_norm2(v_sub(x,z,u)), MACHEPS); - } - - v_copy(y,x); - tracecatch(LUsolve(A,pivot,x,x),"main"); - tracecatch(cond_est = LUcondest(A,pivot),"main"); - if ( v_norm2(v_sub(x,z,u)) >= MACHEPS*v_norm2(x)*cond_est) - { - errmesg("LUfactor()/LUsolve()"); - printf("# LU solution error = %g [cf MACHEPS = %g]\n", - v_norm2(v_sub(x,z,u)), MACHEPS); - } - - vm_mlt(B,z,y); - v_copy(y,x); - tracecatch(LUTsolve(A,pivot,x,x),"main"); - if ( v_norm2(v_sub(x,z,u)) >= MACHEPS*v_norm2(x)*cond_est) - { - errmesg("LUfactor()/LUTsolve()"); - printf("# LU solution error = %g [cf MACHEPS = %g]\n", - v_norm2(v_sub(x,z,u)), MACHEPS); - } - - MEMCHK(); - - /* QR factorisation */ - m_copy(B,A); - mv_mlt(B,z,y); - notice("QR factor/solve:"); - diag = v_get(A->m); - beta = v_get(A->m); - QRfactor(A,diag); - QRsolve(A,diag,y,x); - if ( v_norm2(v_sub(x,z,u)) >= MACHEPS*v_norm2(x)*cond_est ) - { - errmesg("QRfactor()/QRsolve()"); - printf("# QR solution error = %g [cf MACHEPS = %g]\n", - v_norm2(v_sub(x,z,u)), MACHEPS); - } - Q = m_get(A->m,A->m); - makeQ(A,diag,Q); - makeR(A,A); - m_mlt(Q,A,C); - m_sub(B,C,C); - if ( m_norm1(C) >= MACHEPS*m_norm1(Q)*m_norm1(B) ) - { - errmesg("QRfactor()/makeQ()/makeR()"); - printf("# QR reconstruction error = %g [cf MACHEPS = %g]\n", - m_norm1(C), MACHEPS); - } - - MEMCHK(); - - /* now try with a non-square matrix */ - A = m_resize(A,15,7); - m_rand(A); - B = m_copy(A,B); - diag = v_resize(diag,A->n); - beta = v_resize(beta,A->n); - x = v_resize(x,A->n); - y = v_resize(y,A->m); - v_rand(y); - QRfactor(A,diag); - x = QRsolve(A,diag,y,x); - /* z is the residual vector */ - mv_mlt(B,x,z); v_sub(z,y,z); - /* check B^T.z = 0 */ - vm_mlt(B,z,u); - if ( v_norm2(u) >= MACHEPS*m_norm1(B)*v_norm2(y) ) - { - errmesg("QRfactor()/QRsolve()"); - printf("# QR solution error = %g [cf MACHEPS = %g]\n", - v_norm2(u), MACHEPS); - } - Q = m_resize(Q,A->m,A->m); - makeQ(A,diag,Q); - makeR(A,A); - m_mlt(Q,A,C); - m_sub(B,C,C); - if ( m_norm1(C) >= MACHEPS*m_norm1(Q)*m_norm1(B) ) - { - errmesg("QRfactor()/makeQ()/makeR()"); - printf("# QR reconstruction error = %g [cf MACHEPS = %g]\n", - m_norm1(C), MACHEPS); - } - D = m_get(A->m,Q->m); - mtrm_mlt(Q,Q,D); - for ( i = 0; i < D->m; i++ ) - m_set_val(D,i,i,m_entry(D,i,i)-1.0); - if ( m_norm1(D) >= MACHEPS*m_norm1(Q)*m_norm_inf(Q) ) - { - errmesg("QRfactor()/makeQ()/makeR()"); - printf("# QR orthogonality error = %g [cf MACHEPS = %g]\n", - m_norm1(D), MACHEPS); - } - - MEMCHK(); - - /* QRCP factorisation */ - m_copy(B,A); - notice("QR factor/solve with column pivoting"); - pivot = px_resize(pivot,A->n); - QRCPfactor(A,diag,pivot); - z = v_resize(z,A->n); - QRCPsolve(A,diag,pivot,y,z); - /* pxinv_vec(pivot,z,x); */ - /* now compute residual (z) vector */ - mv_mlt(B,x,z); v_sub(z,y,z); - /* check B^T.z = 0 */ - vm_mlt(B,z,u); - if ( v_norm2(u) >= MACHEPS*m_norm1(B)*v_norm2(y) ) - { - errmesg("QRCPfactor()/QRsolve()"); - printf("# QR solution error = %g [cf MACHEPS = %g]\n", - v_norm2(u), MACHEPS); - } - - Q = m_resize(Q,A->m,A->m); - makeQ(A,diag,Q); - makeR(A,A); - m_mlt(Q,A,C); - M_FREE(D); - D = m_get(B->m,B->n); - px_cols(pivot,C,D); - m_sub(B,D,D); - if ( m_norm1(D) >= MACHEPS*m_norm1(Q)*m_norm1(B) ) - { - errmesg("QRCPfactor()/makeQ()/makeR()"); - printf("# QR reconstruction error = %g [cf MACHEPS = %g]\n", - m_norm1(D), MACHEPS); - } - - MEMCHK(); - - /* Cholesky and LDL^T factorisation */ - /* Use these for normal equations approach */ - notice("Cholesky factor/solve"); - mtrm_mlt(B,B,A); - CHfactor(A); - u = v_resize(u,B->n); - vm_mlt(B,y,u); - z = v_resize(z,B->n); - CHsolve(A,u,z); - v_sub(x,z,z); - if ( v_norm2(z) >= MACHEPS*v_norm2(x)*100 ) - { - errmesg("CHfactor()/CHsolve()"); - printf("# Cholesky solution error = %g [cf MACHEPS = %g]\n", - v_norm2(z), MACHEPS); - } - /* modified Cholesky factorisation should be identical with Cholesky - factorisation provided the matrix is "sufficiently positive definite */ - mtrm_mlt(B,B,C); - MCHfactor(C,MACHEPS); - m_sub(A,C,C); - if ( m_norm1(C) >= MACHEPS*m_norm1(A) ) - { - errmesg("MCHfactor()"); - printf("# Modified Cholesky error = %g [cf MACHEPS = %g]\n", - m_norm1(C), MACHEPS); - } - /* now test the LDL^T factorisation -- using a negative def. matrix */ - mtrm_mlt(B,B,A); - sm_mlt(-1.0,A,A); - m_copy(A,C); - LDLfactor(A); - LDLsolve(A,u,z); - w = v_get(A->m); - mv_mlt(C,z,w); - v_sub(w,u,w); - if ( v_norm2(w) >= MACHEPS*v_norm2(u)*m_norm1(C) ) - { - errmesg("LDLfactor()/LDLsolve()"); - printf("# LDL^T residual = %g [cf MACHEPS = %g]\n", - v_norm2(w), MACHEPS); - } - v_add(x,z,z); - if ( v_norm2(z) >= MACHEPS*v_norm2(x)*100 ) - { - errmesg("LDLfactor()/LDLsolve()"); - printf("# LDL^T solution error = %g [cf MACHEPS = %g]\n", - v_norm2(z), MACHEPS); - } - - MEMCHK(); - - /* and now the Bunch-Kaufman-Parlett method */ - /* set up D to be an indefinite diagonal matrix */ - notice("Bunch-Kaufman-Parlett factor/solve"); - - D = m_resize(D,B->m,B->m); - m_zero(D); - w = v_resize(w,B->m); - v_rand(w); - for ( i = 0; i < w->dim; i++ ) - if ( v_entry(w,i) >= 0.5 ) - m_set_val(D,i,i,1.0); - else - m_set_val(D,i,i,-1.0); - /* set A <- B^T.D.B */ - C = m_resize(C,B->n,B->n); - C = mtrm_mlt(B,D,C); - A = m_mlt(C,B,A); - C = m_resize(C,B->n,B->n); - C = m_copy(A,C); - /* ... and use BKPfactor() */ - blocks = px_get(A->m); - pivot = px_resize(pivot,A->m); - x = v_resize(x,A->m); - y = v_resize(y,A->m); - z = v_resize(z,A->m); - v_rand(x); - mv_mlt(A,x,y); - BKPfactor(A,pivot,blocks); - printf("# BKP pivot =\n"); px_output(pivot); - printf("# BKP blocks =\n"); px_output(blocks); - BKPsolve(A,pivot,blocks,y,z); - /* compute & check residual */ - mv_mlt(C,z,w); - v_sub(w,y,w); - if ( v_norm2(w) >= MACHEPS*m_norm1(C)*v_norm2(z) ) - { - errmesg("BKPfactor()/BKPsolve()"); - printf("# BKP residual size = %g [cf MACHEPS = %g]\n", - v_norm2(w), MACHEPS); - } - - /* check update routines */ - /* check LDLupdate() first */ - notice("update L.D.L^T routine"); - A = mtrm_mlt(B,B,A); - m_resize(C,A->m,A->n); - C = m_copy(A,C); - LDLfactor(A); - s1 = 3.7; - w = v_resize(w,A->m); - v_rand(w); - for ( i = 0; i < C->m; i++ ) - for ( j = 0; j < C->n; j++ ) - m_set_val(C,i,j,m_entry(C,i,j)+s1*v_entry(w,i)*v_entry(w,j)); - LDLfactor(C); - LDLupdate(A,w,s1); - /* zero out strictly upper triangular parts of A and C */ - for ( i = 0; i < A->m; i++ ) - for ( j = i+1; j < A->n; j++ ) - { - m_set_val(A,i,j,0.0); - m_set_val(C,i,j,0.0); - } - if ( m_norm1(m_sub(A,C,C)) >= sqrt(MACHEPS)*m_norm1(A) ) - { - errmesg("LDLupdate()"); - printf("# LDL update matrix error = %g [cf MACHEPS = %g]\n", - m_norm1(C), MACHEPS); - } - - - /* BAND MATRICES */ - -#define COL 40 -#define UDIAG 5 -#define LDIAG 2 - - smrand(101); - bA = bd_get(LDIAG,UDIAG,COL); - bB = bd_get(LDIAG,UDIAG,COL); - bC = bd_get(LDIAG,UDIAG,COL); - A = m_resize(A,COL,COL); - B = m_resize(B,COL,COL); - pivot = px_resize(pivot,COL); - x = v_resize(x,COL); - w = v_resize(w,COL); - z = v_resize(z,COL); - - m_rand(A); - /* generate band matrix */ - mat2band(A,LDIAG,UDIAG,bA); - band2mat(bA,A); /* now A is banded */ - bB = bd_copy(bA,bB); - - v_rand(x); - mv_mlt(A,x,w); - z = v_copy(w,z); - - notice("band LU factorization"); - bdLUfactor(bA,pivot); - - /* pivot will be changed */ - bdLUsolve(bA,pivot,z,z); - v_sub(x,z,z); - if (v_norm2(z) > v_norm2(x)*sqrt(MACHEPS)) { - errmesg("incorrect solution (band LU factorization)"); - printf(" ||exact sol. - computed sol.|| = %g [MACHEPS = %g]\n", - v_norm2(z),MACHEPS); - } - - /* solve transpose system */ - - notice("band LU factorization for transpose system"); - m_transp(A,B); - mv_mlt(B,x,w); - - bd_copy(bB,bA); - bd_transp(bA,bA); - /* transposition in situ */ - bd_transp(bA,bA); - bd_transp(bA,bB); - - bdLUfactor(bB,pivot); - - bdLUsolve(bB,pivot,w,z); - v_sub(x,z,z); - if (v_norm2(z) > v_norm2(x)*sqrt(MACHEPS)) { - errmesg("incorrect solution (band transposed LU factorization)"); - printf(" ||exact sol. - computed sol.|| = %g [MACHEPS = %g]\n", - v_norm2(z),MACHEPS); - } - - - /* Cholesky factorization */ - - notice("band Choleski LDL' factorization"); - m_add(A,B,A); /* symmetric matrix */ - for (i=0; i < COL; i++) /* positive definite */ - A->me[i][i] += 2*LDIAG; - - mat2band(A,LDIAG,LDIAG,bA); - band2mat(bA,A); /* corresponding matrix A */ - - v_rand(x); - mv_mlt(A,x,w); - z = v_copy(w,z); - - bdLDLfactor(bA); - - z = bdLDLsolve(bA,z,z); - v_sub(x,z,z); - if (v_norm2(z) > v_norm2(x)*sqrt(MACHEPS)) { - errmesg("incorrect solution (band LDL' factorization)"); - printf(" ||exact sol. - computed sol.|| = %g [MACHEPS = %g]\n", - v_norm2(z),MACHEPS); - } - - /* new bandwidths */ - m_rand(A); - bA = bd_resize(bA,UDIAG,LDIAG,COL); - bB = bd_resize(bB,UDIAG,LDIAG,COL); - mat2band(A,UDIAG,LDIAG,bA); - band2mat(bA,A); - bd_copy(bA,bB); - - mv_mlt(A,x,w); - - notice("band LU factorization (resized)"); - bdLUfactor(bA,pivot); - - /* pivot will be changed */ - bdLUsolve(bA,pivot,w,z); - v_sub(x,z,z); - if (v_norm2(z) > v_norm2(x)*sqrt(MACHEPS)) { - errmesg("incorrect solution (band LU factorization)"); - printf(" ||exact sol. - computed sol.|| = %g [MACHEPS = %g]\n", - v_norm2(z),MACHEPS); - } - - /* testing transposition */ - - notice("band matrix transposition"); - m_zero(bA->mat); - bd_copy(bB,bA); - m_zero(bB->mat); - bd_copy(bA,bB); - - bd_transp(bB,bB); - bd_transp(bB,bB); - - m_zero(bC->mat); - bd_copy(bB,bC); - - m_sub(bA->mat,bC->mat,bC->mat); - if (m_norm_inf(bC->mat) > MACHEPS*bC->mat->n) { - errmesg("band transposition"); - printf(" difference ||A - (A')'|| = %g\n",m_norm_inf(bC->mat)); - } - - bd_free(bA); - bd_free(bB); - bd_free(bC); - - - MEMCHK(); - - /* now check QRupdate() routine */ - notice("update QR routine"); - - B = m_resize(B,15,7); - A = m_resize(A,B->m,B->n); - m_copy(B,A); - diag = v_resize(diag,A->n); - beta = v_resize(beta,A->n); - QRfactor(A,diag); - Q = m_resize(Q,A->m,A->m); - makeQ(A,diag,Q); - makeR(A,A); - m_resize(C,A->m,A->n); - w = v_resize(w,A->m); - v = v_resize(v,A->n); - u = v_resize(u,A->m); - v_rand(w); - v_rand(v); - vm_mlt(Q,w,u); - QRupdate(Q,A,u,v); - m_mlt(Q,A,C); - for ( i = 0; i < B->m; i++ ) - for ( j = 0; j < B->n; j++ ) - m_set_val(B,i,j,m_entry(B,i,j)+v_entry(w,i)*v_entry(v,j)); - m_sub(B,C,C); - if ( m_norm1(C) >= MACHEPS*m_norm1(A)*m_norm1(Q)*2 ) - { - errmesg("QRupdate()"); - printf("# Reconstruction error in QR update = %g [cf MACHEPS = %g]\n", - m_norm1(C), MACHEPS); - } - m_resize(D,Q->m,Q->n); - mtrm_mlt(Q,Q,D); - for ( i = 0; i < D->m; i++ ) - m_set_val(D,i,i,m_entry(D,i,i)-1.0); - if ( m_norm1(D) >= 10*MACHEPS*m_norm1(Q)*m_norm_inf(Q) ) - { - errmesg("QRupdate()"); - printf("# QR update orthogonality error = %g [cf MACHEPS = %g]\n", - m_norm1(D), MACHEPS); - } - - /* Now check eigenvalue/SVD routines */ - notice("eigenvalue and SVD routines"); - A = m_resize(A,11,11); - B = m_resize(B,A->m,A->n); - C = m_resize(C,A->m,A->n); - D = m_resize(D,A->m,A->n); - Q = m_resize(Q,A->m,A->n); - - m_rand(A); - /* A <- A + A^T for symmetric case */ - m_add(A,m_transp(A,C),A); - u = v_resize(u,A->m); - u = symmeig(A,Q,u); - m_zero(B); - for ( i = 0; i < B->m; i++ ) - m_set_val(B,i,i,v_entry(u,i)); - m_mlt(Q,B,C); - mmtr_mlt(C,Q,D); - m_sub(A,D,D); - if ( m_norm1(D) >= MACHEPS*m_norm1(Q)*m_norm_inf(Q)*v_norm_inf(u)*3 ) - { - errmesg("symmeig()"); - printf("# Reconstruction error = %g [cf MACHEPS = %g]\n", - m_norm1(D), MACHEPS); - } - mtrm_mlt(Q,Q,D); - for ( i = 0; i < D->m; i++ ) - m_set_val(D,i,i,m_entry(D,i,i)-1.0); - if ( m_norm1(D) >= MACHEPS*m_norm1(Q)*m_norm_inf(Q)*3 ) - { - errmesg("symmeig()"); - printf("# symmeig() orthogonality error = %g [cf MACHEPS = %g]\n", - m_norm1(D), MACHEPS); - } - - MEMCHK(); - - /* now test (real) Schur decomposition */ - /* m_copy(A,B); */ - M_FREE(A); - A = m_get(11,11); - m_rand(A); - B = m_copy(A,B); - MEMCHK(); - - B = schur(B,Q); - MEMCHK(); - - m_mlt(Q,B,C); - mmtr_mlt(C,Q,D); - MEMCHK(); - m_sub(A,D,D); - if ( m_norm1(D) >= MACHEPS*m_norm1(Q)*m_norm_inf(Q)*m_norm1(B)*5 ) - { - errmesg("schur()"); - printf("# Schur reconstruction error = %g [cf MACHEPS = %g]\n", - m_norm1(D), MACHEPS); - } - - /* orthogonality check */ - mmtr_mlt(Q,Q,D); - for ( i = 0; i < D->m; i++ ) - m_set_val(D,i,i,m_entry(D,i,i)-1.0); - if ( m_norm1(D) >= MACHEPS*m_norm1(Q)*m_norm_inf(Q)*10 ) - { - errmesg("schur()"); - printf("# Schur orthogonality error = %g [cf MACHEPS = %g]\n", - m_norm1(D), MACHEPS); - } - - MEMCHK(); - - /* check for termination */ - Atmp = m_get(2,2); - Qtmp = m_get(2,2); - /* this is a 2 x 2 matrix with real eigenvalues */ - Atmp->me[0][0] = 1; - Atmp->me[1][1] = 1; - Atmp->me[0][1] = 4; - Atmp->me[1][0] = 1; - schur(Atmp,Qtmp); - - MEMCHK(); - - /* now test SVD */ - A = m_resize(A,11,7); - m_rand(A); - U = m_get(A->n,A->n); - Q = m_resize(Q,A->m,A->m); - u = v_resize(u,max(A->m,A->n)); - svd(A,Q,U,u); - /* check reconstruction of A */ - D = m_resize(D,A->m,A->n); - C = m_resize(C,A->m,A->n); - m_zero(D); - for ( i = 0; i < min(A->m,A->n); i++ ) - m_set_val(D,i,i,v_entry(u,i)); - mtrm_mlt(Q,D,C); - m_mlt(C,U,D); - m_sub(A,D,D); - if ( m_norm1(D) >= MACHEPS*m_norm1(U)*m_norm_inf(Q)*m_norm1(A) ) - { - errmesg("svd()"); - printf("# SVD reconstruction error = %g [cf MACHEPS = %g]\n", - m_norm1(D), MACHEPS); - } - /* check orthogonality of Q and U */ - D = m_resize(D,Q->n,Q->n); - mtrm_mlt(Q,Q,D); - for ( i = 0; i < D->m; i++ ) - m_set_val(D,i,i,m_entry(D,i,i)-1.0); - if ( m_norm1(D) >= MACHEPS*m_norm1(Q)*m_norm_inf(Q)*5 ) - { - errmesg("svd()"); - printf("# SVD orthognality error (Q) = %g [cf MACHEPS = %g\n", - m_norm1(D), MACHEPS); - } - D = m_resize(D,U->n,U->n); - mtrm_mlt(U,U,D); - for ( i = 0; i < D->m; i++ ) - m_set_val(D,i,i,m_entry(D,i,i)-1.0); - if ( m_norm1(D) >= MACHEPS*m_norm1(U)*m_norm_inf(U)*5 ) - { - errmesg("svd()"); - printf("# SVD orthognality error (U) = %g [cf MACHEPS = %g\n", - m_norm1(D), MACHEPS); - } - for ( i = 0; i < u->dim; i++ ) - if ( v_entry(u,i) < 0 || (i < u->dim-1 && - v_entry(u,i+1) > v_entry(u,i)) ) - break; - if ( i < u->dim ) - { - errmesg("svd()"); - printf("# SVD sorting error\n"); - } - - - /* test of long vectors */ - notice("Long vectors"); - x = v_resize(x,100000); - y = v_resize(y,100000); - z = v_resize(z,100000); - v_rand(x); - v_rand(y); - v_mltadd(x,y,3.0,z); - sv_mlt(1.0/3.0,z,z); - v_mltadd(z,x,-1.0/3.0,z); - v_sub(z,y,x); - if (v_norm2(x) >= MACHEPS*(x->dim)) { - errmesg("long vectors"); - printf(" norm = %g\n",v_norm2(x)); - } - - mem_stat_free(1); - - MEMCHK(); - - /************************************************** - VEC *x, *y, *z, *u, *v, *w; - VEC *diag, *beta; - PERM *pi1, *pi2, *pi3, *pivot, *blocks; - MAT *A, *B, *C, *D, *Q, *U; - **************************************************/ - V_FREE(x); V_FREE(y); V_FREE(z); - V_FREE(u); V_FREE(v); V_FREE(w); - V_FREE(diag); V_FREE(beta); - PX_FREE(pi1); PX_FREE(pi2); PX_FREE(pi3); - PX_FREE(pivot); PX_FREE(blocks); - M_FREE(A); M_FREE(B); M_FREE(C); - M_FREE(D); M_FREE(Q); M_FREE(U); - M_FREE(Atmp); M_FREE(Qtmp); - - MEMCHK(); - printf("# Finished torture test\n"); - mem_info(); - - return 0; -} - //GO.SYSIN DD torture.c echo sptort.c 1>&2 sed >sptort.c <<'//GO.SYSIN DD sptort.c' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -/* - This file contains tests for the sparse matrix part of Meschach -*/ - -#include <stdio.h> -#include <math.h> -#include "matrix2.h" -#include "sparse2.h" -#include "iter.h" - -#define errmesg(mesg) printf("Error: %s error: line %d\n",mesg,__LINE__) -#define notice(mesg) printf("# Testing %s...\n",mesg); - -/* for iterative methods */ - -#if REAL == DOUBLE -#define EPS 1e-7 -#elif REAL == FLOAT -#define EPS 1e-3 -#endif - -int chk_col_access(A) -SPMAT *A; -{ - int i, j, nxt_idx, nxt_row, scan_cnt, total_cnt; - SPROW *r; - row_elt *e; - - if ( ! A ) - error(E_NULL,"chk_col_access"); - if ( ! A->flag_col ) - return FALSE; - - /* scan down each column, counting the number of entries met */ - scan_cnt = 0; - for ( j = 0; j < A->n; j++ ) - { - i = -1; - nxt_idx = A->start_idx[j]; - nxt_row = A->start_row[j]; - while ( nxt_row >= 0 && nxt_idx >= 0 && nxt_row > i ) - { - i = nxt_row; - r = &(A->row[i]); - e = &(r->elt[nxt_idx]); - nxt_idx = e->nxt_idx; - nxt_row = e->nxt_row; - scan_cnt++; - } - } - - total_cnt = 0; - for ( i = 0; i < A->m; i++ ) - total_cnt += A->row[i].len; - if ( total_cnt != scan_cnt ) - return FALSE; - else - return TRUE; -} - - -void main(argc, argv) -int argc; -char *argv[]; -{ - VEC *x, *y, *z, *u, *v; - Real s1, s2; - PERM *pivot; - SPMAT *A, *B, *C; - SPMAT *B1, *C1; - SPROW *r; - int i, j, k, deg, seed, m, m_old, n, n_old; - - - mem_info_on(TRUE); - - setbuf(stdout, (char *)NULL); - /* get seed if in argument list */ - if ( argc == 1 ) - seed = 1111; - else if ( argc == 2 && sscanf(argv[1],"%d",&seed) == 1 ) - ; - else - { - printf("usage: %s [seed]\n", argv[0]); - exit(0); - } - srand(seed); - - /* set up two random sparse matrices */ - m = 120; - n = 100; - deg = 8; - notice("allocating sparse matrices"); - A = sp_get(m,n,deg); - B = sp_get(m,n,deg); - notice("setting and getting matrix entries"); - for ( k = 0; k < m*deg; k++ ) - { - i = (rand() >> 8) % m; - j = (rand() >> 8) % n; - sp_set_val(A,i,j,rand()/((Real)MAX_RAND)); - i = (rand() >> 8) % m; - j = (rand() >> 8) % n; - sp_set_val(B,i,j,rand()/((Real)MAX_RAND)); - } - for ( k = 0; k < 10; k++ ) - { - s1 = rand()/((Real)MAX_RAND); - i = (rand() >> 8) % m; - j = (rand() >> 8) % n; - sp_set_val(A,i,j,s1); - s2 = sp_get_val(A,i,j); - if ( fabs(s1 - s2) >= MACHEPS ) - break; - } - if ( k < 10 ) - errmesg("sp_set_val()/sp_get_val()"); - - /* test copy routines */ - notice("copy routines"); - x = v_get(n); - y = v_get(m); - z = v_get(m); - /* first copy routine */ - C = sp_copy(A); - for ( k = 0; k < 100; k++ ) - { - v_rand(x); - sp_mv_mlt(A,x,y); - sp_mv_mlt(C,x,z); - if ( v_norm_inf(v_sub(y,z,z)) >= MACHEPS*deg*m ) - break; - } - if ( k < 100 ) - { - errmesg("sp_copy()/sp_mv_mlt()"); - printf("# Error in A.x (inf norm) = %g [cf MACHEPS = %g]\n", - v_norm_inf(z), MACHEPS); - } - /* second copy routine - -- note that A & B have different sparsity patterns */ - - mem_stat_mark(1); - sp_copy2(A,B); - mem_stat_free(1); - for ( k = 0; k < 10; k++ ) - { - v_rand(x); - sp_mv_mlt(A,x,y); - sp_mv_mlt(B,x,z); - if ( v_norm_inf(v_sub(y,z,z)) >= MACHEPS*deg*m ) - break; - } - if ( k < 10 ) - { - errmesg("sp_copy2()/sp_mv_mlt()"); - printf("# Error in A.x (inf norm) = %g [cf MACHEPS = %g]\n", - v_norm_inf(z), MACHEPS); - } - - /* now check compacting routine */ - notice("compacting routine"); - sp_compact(B,0.0); - for ( k = 0; k < 10; k++ ) - { - v_rand(x); - sp_mv_mlt(A,x,y); - sp_mv_mlt(B,x,z); - if ( v_norm_inf(v_sub(y,z,z)) >= MACHEPS*deg*m ) - break; - } - if ( k < 10 ) - { - errmesg("sp_compact()"); - printf("# Error in A.x (inf norm) = %g [cf MACHEPS = %g]\n", - v_norm_inf(z), MACHEPS); - } - for ( i = 0; i < B->m; i++ ) - { - r = &(B->row[i]); - for ( j = 0; j < r->len; j++ ) - if ( r->elt[j].val == 0.0 ) - break; - } - if ( i < B->m ) - { - errmesg("sp_compact()"); - printf("# Zero entry in compacted matrix\n"); - } - - /* check column access paths */ - notice("resizing and access paths"); - m_old = A->m-1; - n_old = A->n-1; - A = sp_resize(A,A->m+10,A->n+10); - for ( k = 0 ; k < 20; k++ ) - { - i = m_old + ((rand() >> 8) % 10); - j = n_old + ((rand() >> 8) % 10); - s1 = rand()/((Real)MAX_RAND); - sp_set_val(A,i,j,s1); - if ( fabs(s1 - sp_get_val(A,i,j)) >= MACHEPS ) - break; - } - if ( k < 20 ) - errmesg("sp_resize()"); - sp_col_access(A); - if ( ! chk_col_access(A) ) - { - errmesg("sp_col_access()"); - } - sp_diag_access(A); - for ( i = 0; i < A->m; i++ ) - { - r = &(A->row[i]); - if ( r->diag != sprow_idx(r,i) ) - break; - } - if ( i < A->m ) - { - errmesg("sp_diag_access()"); - } - - /* test both sp_mv_mlt() and sp_vm_mlt() */ - x = v_resize(x,B->n); - y = v_resize(y,B->m); - u = v_get(B->m); - v = v_get(B->n); - for ( k = 0; k < 10; k++ ) - { - v_rand(x); - v_rand(y); - sp_mv_mlt(B,x,u); - sp_vm_mlt(B,y,v); - if ( fabs(in_prod(x,v) - in_prod(y,u)) >= - MACHEPS*v_norm2(x)*v_norm2(u)*5 ) - break; - } - if ( k < 10 ) - { - errmesg("sp_mv_mlt()/sp_vm_mlt()"); - printf("# Error in inner products = %g [cf MACHEPS = %g]\n", - fabs(in_prod(x,v) - in_prod(y,u)), MACHEPS); - } - - SP_FREE(A); - SP_FREE(B); - SP_FREE(C); - - /* now test Cholesky and LU factorise and solve */ - notice("sparse Cholesky factorise/solve"); - A = iter_gen_sym(120,8); - B = sp_copy(A); - spCHfactor(A); - x = v_resize(x,A->m); - y = v_resize(y,A->m); - v_rand(x); - sp_mv_mlt(B,x,y); - z = v_resize(z,A->m); - spCHsolve(A,y,z); - v = v_resize(v,A->m); - sp_mv_mlt(B,z,v); - /* compute residual */ - v_sub(y,v,v); - if ( v_norm2(v) >= MACHEPS*v_norm2(y)*10 ) - { - errmesg("spCHfactor()/spCHsolve()"); - printf("# Sparse Cholesky residual = %g [cf MACHEPS = %g]\n", - v_norm2(v), MACHEPS); - } - /* compute error in solution */ - v_sub(x,z,z); - if ( v_norm2(z) > MACHEPS*v_norm2(x)*10 ) - { - errmesg("spCHfactor()/spCHsolve()"); - printf("# Solution error = %g [cf MACHEPS = %g]\n", - v_norm2(z), MACHEPS); - } - - /* now test symbolic and incomplete factorisation */ - SP_FREE(A); - A = sp_copy(B); - - mem_stat_mark(2); - spCHsymb(A); - mem_stat_mark(2); - - spICHfactor(A); - spCHsolve(A,y,z); - v = v_resize(v,A->m); - sp_mv_mlt(B,z,v); - /* compute residual */ - v_sub(y,v,v); - if ( v_norm2(v) >= MACHEPS*v_norm2(y)*5 ) - { - errmesg("spCHsymb()/spICHfactor()"); - printf("# Sparse Cholesky residual = %g [cf MACHEPS = %g]\n", - v_norm2(v), MACHEPS); - } - /* compute error in solution */ - v_sub(x,z,z); - if ( v_norm2(z) > MACHEPS*v_norm2(x)*10 ) - { - errmesg("spCHsymb()/spICHfactor()"); - printf("# Solution error = %g [cf MACHEPS = %g]\n", - v_norm2(z), MACHEPS); - } - - /* now test sparse LU factorisation */ - notice("sparse LU factorise/solve"); - SP_FREE(A); - SP_FREE(B); - A = iter_gen_nonsym(100,100,8,1.0); - - B = sp_copy(A); - x = v_resize(x,A->n); - z = v_resize(z,A->n); - y = v_resize(y,A->m); - v = v_resize(v,A->m); - - v_rand(x); - sp_mv_mlt(B,x,y); - pivot = px_get(A->m); - - mem_stat_mark(3); - spLUfactor(A,pivot,0.1); - spLUsolve(A,pivot,y,z); - mem_stat_free(3); - sp_mv_mlt(B,z,v); - - /* compute residual */ - v_sub(y,v,v); - if ( v_norm2(v) >= MACHEPS*v_norm2(y)*A->m ) - { - errmesg("spLUfactor()/spLUsolve()"); - printf("# Sparse LU residual = %g [cf MACHEPS = %g]\n", - v_norm2(v), MACHEPS); - } - /* compute error in solution */ - v_sub(x,z,z); - if ( v_norm2(z) > MACHEPS*v_norm2(x)*100*A->m ) - { - errmesg("spLUfactor()/spLUsolve()"); - printf("# Sparse LU solution error = %g [cf MACHEPS = %g]\n", - v_norm2(z), MACHEPS); - } - - /* now check spLUTsolve */ - mem_stat_mark(4); - sp_vm_mlt(B,x,y); - spLUTsolve(A,pivot,y,z); - sp_vm_mlt(B,z,v); - mem_stat_free(4); - - /* compute residual */ - v_sub(y,v,v); - if ( v_norm2(v) >= MACHEPS*v_norm2(y)*A->m ) - { - errmesg("spLUTsolve()"); - printf("# Sparse LU residual = %g [cf MACHEPS = %g]\n", - v_norm2(v), MACHEPS); - } - /* compute error in solution */ - v_sub(x,z,z); - if ( v_norm2(z) > MACHEPS*v_norm2(x)*100*A->m ) - { - errmesg("spLUTsolve()"); - printf("# Sparse LU solution error = %g [cf MACHEPS = %g]\n", - v_norm2(z), MACHEPS); - } - - /* algebraic operations */ - notice("addition,subtraction and multiplying by a number"); - SP_FREE(A); - SP_FREE(B); - - m = 120; - n = 120; - deg = 5; - A = sp_get(m,n,deg); - B = sp_get(m,n,deg); - C = sp_get(m,n,deg); - C1 = sp_get(m,n,deg); - - for ( k = 0; k < m*deg; k++ ) - { - i = (rand() >> 8) % m; - j = (rand() >> 8) % n; - sp_set_val(A,i,j,rand()/((Real)MAX_RAND)); - i = (rand() >> 8) % m; - j = (rand() >> 8) % n; - sp_set_val(B,i,j,rand()/((Real)MAX_RAND)); - } - - s1 = mrand(); - B1 = sp_copy(B); - - mem_stat_mark(1); - sp_smlt(B,s1,C); - sp_add(A,C,C1); - sp_sub(C1,A,C); - sp_smlt(C,-1.0/s1,C); - sp_add(C,B1,C); - - s2 = 0.0; - for (k=0; k < C->m; k++) { - r = &(C->row[k]); - for (j=0; j < r->len; j++) { - if (s2 < fabs(r->elt[j].val)) - s2 = fabs(r->elt[j].val); - } - } - - if (s2 > MACHEPS*A->m) { - errmesg("add, sub, mlt sparse matrices (args not in situ)\n"); - printf(" difference = %g [MACEPS = %g]\n",s2,MACHEPS); - } - - sp_mltadd(A,B1,s1,C1); - sp_sub(C1,A,A); - sp_smlt(A,1.0/s1,C1); - sp_sub(C1,B1,C1); - mem_stat_free(1); - - s2 = 0.0; - for (k=0; k < C1->m; k++) { - r = &(C1->row[k]); - for (j=0; j < r->len; j++) { - if (s2 < fabs(r->elt[j].val)) - s2 = fabs(r->elt[j].val); - } - } - - if (s2 > MACHEPS*A->m) { - errmesg("add, sub, mlt sparse matrices (args not in situ)\n"); - printf(" difference = %g [MACEPS = %g]\n",s2,MACHEPS); - } - - V_FREE(x); - V_FREE(y); - V_FREE(z); - V_FREE(u); - V_FREE(v); - PX_FREE(pivot); - SP_FREE(A); - SP_FREE(B); - SP_FREE(C); - SP_FREE(B1); - SP_FREE(C1); - - printf("# Done testing (%s)\n",argv[0]); - mem_info(); -} - - - - - //GO.SYSIN DD sptort.c echo ztorture.c 1>&2 sed >ztorture.c <<'//GO.SYSIN DD ztorture.c' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -/* - This file contains a series of tests for the Meschach matrix - library, complex routines -*/ - -static char rcsid[] = "$Id: $"; - -#include <stdio.h> -#include <math.h> -#include "zmatrix2.h" -#include "matlab.h" - - -#define errmesg(mesg) printf("Error: %s error: line %d\n",mesg,__LINE__) -#define notice(mesg) printf("# Testing %s...\n",mesg); - -/* extern int malloc_chain_check(); */ -/* #define MEMCHK() if ( malloc_chain_check(0) ) \ -{ printf("Error in malloc chain: \"%s\", line %d\n", \ - __FILE__, __LINE__); exit(0); } */ -#define MEMCHK() - -/* cmp_perm -- returns 1 if pi1 == pi2, 0 otherwise */ -int cmp_perm(pi1, pi2) -PERM *pi1, *pi2; -{ - int i; - - if ( ! pi1 || ! pi2 ) - error(E_NULL,"cmp_perm"); - if ( pi1->size != pi2->size ) - return 0; - for ( i = 0; i < pi1->size; i++ ) - if ( pi1->pe[i] != pi2->pe[i] ) - return 0; - return 1; -} - -/* px_rand -- generates sort-of random permutation */ -PERM *px_rand(pi) -PERM *pi; -{ - int i, j, k; - - if ( ! pi ) - error(E_NULL,"px_rand"); - - for ( i = 0; i < 3*pi->size; i++ ) - { - j = (rand() >> 8) % pi->size; - k = (rand() >> 8) % pi->size; - px_transp(pi,j,k); - } - - return pi; -} - -#define SAVE_FILE "asx5213a.mat" -#define MATLAB_NAME "alpha" -char name[81] = MATLAB_NAME; - -void main(argc, argv) -int argc; -char *argv[]; -{ - ZVEC *x = ZVNULL, *y = ZVNULL, *z = ZVNULL, *u = ZVNULL; - ZVEC *diag = ZVNULL; - PERM *pi1 = PNULL, *pi2 = PNULL, *pivot = PNULL; - ZMAT *A = ZMNULL, *B = ZMNULL, *C = ZMNULL, *D = ZMNULL, - *Q = ZMNULL; - complex ONE; - complex z1, z2, z3; - Real cond_est, s1, s2, s3; - int i, seed; - FILE *fp; - char *cp; - - - mem_info_on(TRUE); - - setbuf(stdout,(char *)NULL); - - seed = 1111; - if ( argc > 2 ) - { - printf("usage: %s [seed]\n",argv[0]); - exit(0); - } - else if ( argc == 2 ) - sscanf(argv[1], "%d", &seed); - - /* set seed for rand() */ - smrand(seed); - - /* print out version information */ - m_version(); - - printf("# Meschach Complex numbers & vectors torture test\n\n"); - printf("# grep \"^Error\" the output for a listing of errors\n"); - printf("# Don't panic if you see \"Error\" appearing; \n"); - printf("# Also check the reported size of error\n"); - printf("# This program uses randomly generated problems and therefore\n"); - printf("# may occasionally produce ill-conditioned problems\n"); - printf("# Therefore check the size of the error compared with MACHEPS\n"); - printf("# If the error is within 1000*MACHEPS then don't worry\n"); - printf("# If you get an error of size 0.1 or larger there is \n"); - printf("# probably a bug in the code or the compilation procedure\n\n"); - printf("# seed = %d\n",seed); - - printf("\n"); - - mem_stat_mark(1); - - notice("complex arithmetic & special functions"); - - ONE = zmake(1.0,0.0); - printf("# ONE = "); z_output(ONE); - z1.re = mrand(); z1.im = mrand(); - z2.re = mrand(); z2.im = mrand(); - z3 = zadd(z1,z2); - if ( fabs(z1.re+z2.re-z3.re) + fabs(z1.im+z2.im-z3.im) > 10*MACHEPS ) - errmesg("zadd"); - z3 = zsub(z1,z2); - if ( fabs(z1.re-z2.re-z3.re) + fabs(z1.im-z2.im-z3.im) > 10*MACHEPS ) - errmesg("zadd"); - z3 = zmlt(z1,z2); - if ( fabs(z1.re*z2.re - z1.im*z2.im - z3.re) + - fabs(z1.im*z2.re + z1.re*z2.im - z3.im) > 10*MACHEPS ) - errmesg("zmlt"); - s1 = zabs(z1); - if ( fabs(s1*s1 - (z1.re*z1.re+z1.im*z1.im)) > 10*MACHEPS ) - errmesg("zabs"); - if ( zabs(zsub(z1,zmlt(z2,zdiv(z1,z2)))) > 10*MACHEPS || - zabs(zsub(ONE,zdiv(z1,zmlt(z2,zdiv(z1,z2))))) > 10*MACHEPS ) - errmesg("zdiv"); - - z3 = zsqrt(z1); - if ( zabs(zsub(z1,zmlt(z3,z3))) > 10*MACHEPS ) - errmesg("zsqrt"); - if ( zabs(zsub(z1,zlog(zexp(z1)))) > 10*MACHEPS ) - errmesg("zexp/zlog"); - - - printf("# Check: MACHEPS = %g\n",MACHEPS); - /* allocate, initialise, copy and resize operations */ - /* ZVEC */ - notice("vector initialise, copy & resize"); - x = zv_get(12); - y = zv_get(15); - z = zv_get(12); - zv_rand(x); - zv_rand(y); - z = zv_copy(x,z); - if ( zv_norm2(zv_sub(x,z,z)) >= MACHEPS ) - errmesg("ZVEC copy"); - zv_copy(x,y); - x = zv_resize(x,10); - y = zv_resize(y,10); - if ( zv_norm2(zv_sub(x,y,z)) >= MACHEPS ) - errmesg("ZVEC copy/resize"); - x = zv_resize(x,15); - y = zv_resize(y,15); - if ( zv_norm2(zv_sub(x,y,z)) >= MACHEPS ) - errmesg("VZEC resize"); - - /* ZMAT */ - notice("matrix initialise, copy & resize"); - A = zm_get(8,5); - B = zm_get(3,9); - C = zm_get(8,5); - zm_rand(A); - zm_rand(B); - C = zm_copy(A,C); - if ( zm_norm_inf(zm_sub(A,C,C)) >= MACHEPS ) - errmesg("ZMAT copy"); - zm_copy(A,B); - A = zm_resize(A,3,5); - B = zm_resize(B,3,5); - if ( zm_norm_inf(zm_sub(A,B,C)) >= MACHEPS ) - errmesg("ZMAT copy/resize"); - A = zm_resize(A,10,10); - B = zm_resize(B,10,10); - if ( zm_norm_inf(zm_sub(A,B,C)) >= MACHEPS ) - errmesg("ZMAT resize"); - - MEMCHK(); - - /* PERM */ - notice("permutation initialise, inverting & permuting vectors"); - pi1 = px_get(15); - pi2 = px_get(12); - px_rand(pi1); - zv_rand(x); - px_zvec(pi1,x,z); - y = zv_resize(y,x->dim); - pxinv_zvec(pi1,z,y); - if ( zv_norm2(zv_sub(x,y,z)) >= MACHEPS ) - errmesg("PERMute vector"); - - /* testing catch() etc */ - notice("error handling routines"); - catch(E_NULL, - catchall(zv_add(ZVNULL,ZVNULL,ZVNULL); - errmesg("tracecatch() failure"), - printf("# tracecatch() caught error\n"); - error(E_NULL,"main")); - errmesg("catch() failure"), - printf("# catch() caught E_NULL error\n")); - - /* testing inner products and v_mltadd() etc */ - notice("inner products and linear combinations"); - u = zv_get(x->dim); - zv_rand(u); - zv_rand(x); - zv_resize(y,x->dim); - zv_rand(y); - zv_mltadd(y,x,zneg(zdiv(zin_prod(x,y),zin_prod(x,x))),z); - if ( zabs(zin_prod(x,z)) >= 5*MACHEPS*x->dim ) - { - errmesg("zv_mltadd()/zin_prod()"); - printf("# error norm = %g\n", zabs(zin_prod(x,z))); - } - - z1 = zneg(zdiv(zin_prod(x,y),zmake(zv_norm2(x)*zv_norm2(x),0.0))); - zv_mlt(z1,x,u); - zv_add(y,u,u); - if ( zv_norm2(zv_sub(u,z,u)) >= MACHEPS*x->dim ) - { - errmesg("zv_mlt()/zv_norm2()"); - printf("# error norm = %g\n", zv_norm2(u)); - } - -#ifdef ANSI_C - zv_linlist(u,x,z1,y,ONE,VNULL); - if ( zv_norm2(zv_sub(u,z,u)) >= MACHEPS*x->dim ) - errmesg("zv_linlist()"); -#endif -#ifdef VARARGS - zv_linlist(u,x,z1,y,ONE,VNULL); - if ( zv_norm2(zv_sub(u,z,u)) >= MACHEPS*x->dim ) - errmesg("zv_linlist()"); -#endif - - MEMCHK(); - - /* vector norms */ - notice("vector norms"); - x = zv_resize(x,12); - zv_rand(x); - for ( i = 0; i < x->dim; i++ ) - if ( zabs(v_entry(x,i)) >= 0.7 ) - v_set_val(x,i,ONE); - else - v_set_val(x,i,zneg(ONE)); - s1 = zv_norm1(x); - s2 = zv_norm2(x); - s3 = zv_norm_inf(x); - if ( fabs(s1 - x->dim) >= MACHEPS*x->dim || - fabs(s2 - sqrt((double)(x->dim))) >= MACHEPS*x->dim || - fabs(s3 - 1.0) >= MACHEPS ) - errmesg("zv_norm1/2/_inf()"); - - /* test matrix multiply etc */ - notice("matrix multiply and invert"); - A = zm_resize(A,10,10); - B = zm_resize(B,10,10); - zm_rand(A); - zm_inverse(A,B); - zm_mlt(A,B,C); - for ( i = 0; i < C->m; i++ ) - m_set_val(C,i,i,zsub(m_entry(C,i,i),ONE)); - if ( zm_norm_inf(C) >= MACHEPS*zm_norm_inf(A)*zm_norm_inf(B)*5 ) - errmesg("zm_inverse()/zm_mlt()"); - - MEMCHK(); - - /* ... and adjoints */ - notice("adjoints and adjoint-multiplies"); - zm_adjoint(A,A); /* can do square matrices in situ */ - zmam_mlt(A,B,C); - for ( i = 0; i < C->m; i++ ) - m_set_val(C,i,i,zsub(m_entry(C,i,i),ONE)); - if ( zm_norm_inf(C) >= MACHEPS*zm_norm_inf(A)*zm_norm_inf(B)*5 ) - errmesg("zm_adjoint()/zmam_mlt()"); - zm_adjoint(A,A); - zm_adjoint(B,B); - zmma_mlt(A,B,C); - for ( i = 0; i < C->m; i++ ) - m_set_val(C,i,i,zsub(m_entry(C,i,i),ONE)); - if ( zm_norm_inf(C) >= MACHEPS*zm_norm_inf(A)*zm_norm_inf(B)*5 ) - errmesg("zm_adjoint()/zmma_mlt()"); - zsm_mlt(zmake(3.71,2.753),B,B); - zmma_mlt(A,B,C); - for ( i = 0; i < C->m; i++ ) - m_set_val(C,i,i,zsub(m_entry(C,i,i),zmake(3.71,-2.753))); - if ( zm_norm_inf(C) >= MACHEPS*zm_norm_inf(A)*zm_norm_inf(B)*5 ) - errmesg("szm_mlt()/zmma_mlt()"); - zm_adjoint(B,B); - zsm_mlt(zdiv(ONE,zmake(3.71,-2.753)),B,B); - - MEMCHK(); - - /* ... and matrix-vector multiplies */ - notice("matrix-vector multiplies"); - x = zv_resize(x,A->n); - y = zv_resize(y,A->m); - z = zv_resize(z,A->m); - u = zv_resize(u,A->n); - zv_rand(x); - zv_rand(y); - zmv_mlt(A,x,z); - z1 = zin_prod(y,z); - zvm_mlt(A,y,u); - z2 = zin_prod(u,x); - if ( zabs(zsub(z1,z2)) >= (MACHEPS*x->dim)*x->dim ) - { - errmesg("zmv_mlt()/zvm_mlt()"); - printf("# difference between inner products is %g\n", - zabs(zsub(z1,z2))); - } - zmv_mlt(B,z,u); - if ( zv_norm2(zv_sub(u,x,u)) >= MACHEPS*zm_norm_inf(A)*zm_norm_inf(B)*5 ) - errmesg("zmv_mlt()/zvm_mlt()"); - - MEMCHK(); - - /* get/set row/col */ - notice("getting and setting rows and cols"); - x = zv_resize(x,A->n); - y = zv_resize(y,B->m); - x = zget_row(A,3,x); - y = zget_col(B,3,y); - if ( zabs(zsub(_zin_prod(x,y,0,Z_NOCONJ),ONE)) >= - MACHEPS*zm_norm_inf(A)*zm_norm_inf(B)*5 ) - errmesg("zget_row()/zget_col()"); - zv_mlt(zmake(-1.0,0.0),x,x); - zv_mlt(zmake(-1.0,0.0),y,y); - zset_row(A,3,x); - zset_col(B,3,y); - zm_mlt(A,B,C); - for ( i = 0; i < C->m; i++ ) - m_set_val(C,i,i,zsub(m_entry(C,i,i),ONE)); - if ( zm_norm_inf(C) >= MACHEPS*zm_norm_inf(A)*zm_norm_inf(B)*5 ) - errmesg("zset_row()/zset_col()"); - - MEMCHK(); - - /* matrix norms */ - notice("matrix norms"); - A = zm_resize(A,11,15); - zm_rand(A); - s1 = zm_norm_inf(A); - B = zm_adjoint(A,B); - s2 = zm_norm1(B); - if ( fabs(s1 - s2) >= MACHEPS*A->m ) - errmesg("zm_norm1()/zm_norm_inf()"); - C = zmam_mlt(A,A,C); - z1.re = z1.im = 0.0; - for ( i = 0; i < C->m && i < C->n; i++ ) - z1 = zadd(z1,m_entry(C,i,i)); - if ( fabs(sqrt(z1.re) - zm_norm_frob(A)) >= MACHEPS*A->m*A->n ) - errmesg("zm_norm_frob"); - - MEMCHK(); - - /* permuting rows and columns */ - /****************************** - notice("permuting rows & cols"); - A = zm_resize(A,11,15); - B = zm_resize(B,11,15); - pi1 = px_resize(pi1,A->m); - px_rand(pi1); - x = zv_resize(x,A->n); - y = zmv_mlt(A,x,y); - px_rows(pi1,A,B); - px_zvec(pi1,y,z); - zmv_mlt(B,x,u); - if ( zv_norm2(zv_sub(z,u,u)) >= MACHEPS*A->m ) - errmesg("px_rows()"); - pi1 = px_resize(pi1,A->n); - px_rand(pi1); - px_cols(pi1,A,B); - pxinv_zvec(pi1,x,z); - zmv_mlt(B,z,u); - if ( zv_norm2(zv_sub(y,u,u)) >= MACHEPS*A->n ) - errmesg("px_cols()"); - ******************************/ - - MEMCHK(); - - /* MATLAB save/load */ - notice("MATLAB save/load"); - A = zm_resize(A,12,11); - if ( (fp=fopen(SAVE_FILE,"w")) == (FILE *)NULL ) - printf("Cannot perform MATLAB save/load test\n"); - else - { - zm_rand(A); - zm_save(fp, A, name); - fclose(fp); - if ( (fp=fopen(SAVE_FILE,"r")) == (FILE *)NULL ) - printf("Cannot open save file \"%s\"\n",SAVE_FILE); - else - { - ZM_FREE(B); - B = zm_load(fp,&cp); - if ( strcmp(name,cp) || zm_norm1(zm_sub(A,B,C)) >= - MACHEPS*A->m ) - { - errmesg("zm_load()/zm_save()"); - printf("# orig. name = %s, restored name = %s\n", name, cp); - printf("# orig. A =\n"); zm_output(A); - printf("# restored A =\n"); zm_output(B); - } - } - } - - MEMCHK(); - - /* Now, onto matrix factorisations */ - A = zm_resize(A,10,10); - B = zm_resize(B,A->m,A->n); - zm_copy(A,B); - x = zv_resize(x,A->n); - y = zv_resize(y,A->m); - z = zv_resize(z,A->n); - u = zv_resize(u,A->m); - zv_rand(x); - zmv_mlt(B,x,y); - z = zv_copy(x,z); - - notice("LU factor/solve"); - pivot = px_get(A->m); - zLUfactor(A,pivot); - tracecatch(zLUsolve(A,pivot,y,x),"main"); - tracecatch(cond_est = zLUcondest(A,pivot),"main"); - printf("# cond(A) approx= %g\n", cond_est); - if ( zv_norm2(zv_sub(x,z,u)) >= MACHEPS*zv_norm2(x)*cond_est) - { - errmesg("zLUfactor()/zLUsolve()"); - printf("# LU solution error = %g [cf MACHEPS = %g]\n", - zv_norm2(zv_sub(x,z,u)), MACHEPS); - } - - - zv_copy(y,x); - tracecatch(zLUsolve(A,pivot,x,x),"main"); - tracecatch(cond_est = zLUcondest(A,pivot),"main"); - if ( zv_norm2(zv_sub(x,z,u)) >= MACHEPS*zv_norm2(x)*cond_est) - { - errmesg("zLUfactor()/zLUsolve()"); - printf("# LU solution error = %g [cf MACHEPS = %g]\n", - zv_norm2(zv_sub(x,z,u)), MACHEPS); - } - - zvm_mlt(B,z,y); - zv_copy(y,x); - tracecatch(zLUAsolve(A,pivot,x,x),"main"); - if ( zv_norm2(zv_sub(x,z,u)) >= MACHEPS*zv_norm2(x)*cond_est) - { - errmesg("zLUfactor()/zLUAsolve()"); - printf("# LU solution error = %g [cf MACHEPS = %g]\n", - zv_norm2(zv_sub(x,z,u)), MACHEPS); - } - - MEMCHK(); - - /* QR factorisation */ - zm_copy(B,A); - zmv_mlt(B,z,y); - notice("QR factor/solve:"); - diag = zv_get(A->m); - zQRfactor(A,diag); - zQRsolve(A,diag,y,x); - if ( zv_norm2(zv_sub(x,z,u)) >= MACHEPS*zv_norm2(x)*cond_est ) - { - errmesg("zQRfactor()/zQRsolve()"); - printf("# QR solution error = %g [cf MACHEPS = %g]\n", - zv_norm2(zv_sub(x,z,u)), MACHEPS); - } - printf("# QR cond(A) approx= %g\n", zQRcondest(A)); - Q = zm_get(A->m,A->m); - zmakeQ(A,diag,Q); - zmakeR(A,A); - zm_mlt(Q,A,C); - zm_sub(B,C,C); - if ( zm_norm1(C) >= MACHEPS*zm_norm1(Q)*zm_norm1(B) ) - { - errmesg("zQRfactor()/zmakeQ()/zmakeR()"); - printf("# QR reconstruction error = %g [cf MACHEPS = %g]\n", - zm_norm1(C), MACHEPS); - } - - MEMCHK(); - - /* now try with a non-square matrix */ - A = zm_resize(A,15,7); - zm_rand(A); - B = zm_copy(A,B); - diag = zv_resize(diag,A->n); - x = zv_resize(x,A->n); - y = zv_resize(y,A->m); - zv_rand(y); - zQRfactor(A,diag); - x = zQRsolve(A,diag,y,x); - /* z is the residual vector */ - zmv_mlt(B,x,z); zv_sub(z,y,z); - /* check B*.z = 0 */ - zvm_mlt(B,z,u); - if ( zv_norm2(u) >= 100*MACHEPS*zm_norm1(B)*zv_norm2(y) ) - { - errmesg("zQRfactor()/zQRsolve()"); - printf("# QR solution error = %g [cf MACHEPS = %g]\n", - zv_norm2(u), MACHEPS); - } - Q = zm_resize(Q,A->m,A->m); - zmakeQ(A,diag,Q); - zmakeR(A,A); - zm_mlt(Q,A,C); - zm_sub(B,C,C); - if ( zm_norm1(C) >= MACHEPS*zm_norm1(Q)*zm_norm1(B) ) - { - errmesg("zQRfactor()/zmakeQ()/zmakeR()"); - printf("# QR reconstruction error = %g [cf MACHEPS = %g]\n", - zm_norm1(C), MACHEPS); - } - D = zm_get(A->m,Q->m); - zmam_mlt(Q,Q,D); - for ( i = 0; i < D->m; i++ ) - m_set_val(D,i,i,zsub(m_entry(D,i,i),ONE)); - if ( zm_norm1(D) >= MACHEPS*zm_norm1(Q)*zm_norm_inf(Q) ) - { - errmesg("QRfactor()/makeQ()/makeR()"); - printf("# QR orthogonality error = %g [cf MACHEPS = %g]\n", - zm_norm1(D), MACHEPS); - } - - MEMCHK(); - - /* QRCP factorisation */ - zm_copy(B,A); - notice("QR factor/solve with column pivoting"); - pivot = px_resize(pivot,A->n); - zQRCPfactor(A,diag,pivot); - z = zv_resize(z,A->n); - zQRCPsolve(A,diag,pivot,y,z); - /* pxinv_zvec(pivot,z,x); */ - /* now compute residual (z) vector */ - zmv_mlt(B,x,z); zv_sub(z,y,z); - /* check B^T.z = 0 */ - zvm_mlt(B,z,u); - if ( zv_norm2(u) >= MACHEPS*zm_norm1(B)*zv_norm2(y) ) - { - errmesg("QRCPfactor()/QRsolve()"); - printf("# QR solution error = %g [cf MACHEPS = %g]\n", - zv_norm2(u), MACHEPS); - } - - Q = zm_resize(Q,A->m,A->m); - zmakeQ(A,diag,Q); - zmakeR(A,A); - zm_mlt(Q,A,C); - ZM_FREE(D); - D = zm_get(B->m,B->n); - /****************************** - px_cols(pivot,C,D); - zm_sub(B,D,D); - if ( zm_norm1(D) >= MACHEPS*zm_norm1(Q)*zm_norm1(B) ) - { - errmesg("QRCPfactor()/makeQ()/makeR()"); - printf("# QR reconstruction error = %g [cf MACHEPS = %g]\n", - zm_norm1(D), MACHEPS); - } - ******************************/ - - /* Now check eigenvalue/SVD routines */ - notice("complex Schur routines"); - A = zm_resize(A,11,11); - B = zm_resize(B,A->m,A->n); - C = zm_resize(C,A->m,A->n); - D = zm_resize(D,A->m,A->n); - Q = zm_resize(Q,A->m,A->n); - - MEMCHK(); - - /* now test complex Schur decomposition */ - /* zm_copy(A,B); */ - ZM_FREE(A); - A = zm_get(11,11); - zm_rand(A); - B = zm_copy(A,B); - MEMCHK(); - - B = zschur(B,Q); - MEMCHK(); - - zm_mlt(Q,B,C); - zmma_mlt(C,Q,D); - MEMCHK(); - zm_sub(A,D,D); - if ( zm_norm1(D) >= MACHEPS*zm_norm1(Q)*zm_norm_inf(Q)*zm_norm1(B)*5 ) - { - errmesg("zschur()"); - printf("# Schur reconstruction error = %g [cf MACHEPS = %g]\n", - zm_norm1(D), MACHEPS); - } - - /* orthogonality check */ - zmma_mlt(Q,Q,D); - for ( i = 0; i < D->m; i++ ) - m_set_val(D,i,i,zsub(m_entry(D,i,i),ONE)); - if ( zm_norm1(D) >= MACHEPS*zm_norm1(Q)*zm_norm_inf(Q)*10 ) - { - errmesg("zschur()"); - printf("# Schur orthogonality error = %g [cf MACHEPS = %g]\n", - zm_norm1(D), MACHEPS); - } - - MEMCHK(); - - /* now test SVD */ - /****************************** - A = zm_resize(A,11,7); - zm_rand(A); - U = zm_get(A->n,A->n); - Q = zm_resize(Q,A->m,A->m); - u = zv_resize(u,max(A->m,A->n)); - svd(A,Q,U,u); - ******************************/ - /* check reconstruction of A */ - /****************************** - D = zm_resize(D,A->m,A->n); - C = zm_resize(C,A->m,A->n); - zm_zero(D); - for ( i = 0; i < min(A->m,A->n); i++ ) - zm_set_val(D,i,i,v_entry(u,i)); - zmam_mlt(Q,D,C); - zm_mlt(C,U,D); - zm_sub(A,D,D); - if ( zm_norm1(D) >= MACHEPS*zm_norm1(U)*zm_norm_inf(Q)*zm_norm1(A) ) - { - errmesg("svd()"); - printf("# SVD reconstruction error = %g [cf MACHEPS = %g]\n", - zm_norm1(D), MACHEPS); - } - ******************************/ - /* check orthogonality of Q and U */ - /****************************** - D = zm_resize(D,Q->n,Q->n); - zmam_mlt(Q,Q,D); - for ( i = 0; i < D->m; i++ ) - m_set_val(D,i,i,m_entry(D,i,i)-1.0); - if ( zm_norm1(D) >= MACHEPS*zm_norm1(Q)*zm_norm_inf(Q)*5 ) - { - errmesg("svd()"); - printf("# SVD orthognality error (Q) = %g [cf MACHEPS = %g\n", - zm_norm1(D), MACHEPS); - } - D = zm_resize(D,U->n,U->n); - zmam_mlt(U,U,D); - for ( i = 0; i < D->m; i++ ) - m_set_val(D,i,i,m_entry(D,i,i)-1.0); - if ( zm_norm1(D) >= MACHEPS*zm_norm1(U)*zm_norm_inf(U)*5 ) - { - errmesg("svd()"); - printf("# SVD orthognality error (U) = %g [cf MACHEPS = %g\n", - zm_norm1(D), MACHEPS); - } - for ( i = 0; i < u->dim; i++ ) - if ( v_entry(u,i) < 0 || (i < u->dim-1 && - v_entry(u,i+1) > v_entry(u,i)) ) - break; - if ( i < u->dim ) - { - errmesg("svd()"); - printf("# SVD sorting error\n"); - } - ******************************/ - - ZV_FREE(x); ZV_FREE(y); ZV_FREE(z); - ZV_FREE(u); ZV_FREE(diag); - PX_FREE(pi1); PX_FREE(pi2); PX_FREE(pivot); - ZM_FREE(A); ZM_FREE(B); ZM_FREE(C); - ZM_FREE(D); ZM_FREE(Q); - - mem_stat_free(1); - - MEMCHK(); - printf("# Finished torture test for complex numbers/vectors/matrices\n"); - mem_info(); -} - //GO.SYSIN DD ztorture.c echo memtort.c 1>&2 sed >memtort.c <<'//GO.SYSIN DD memtort.c' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -/* - Tests for mem_info.c functions - */ - -static char rcsid[] = "$Id: $"; - -#include <stdio.h> -#include <math.h> -#include "matrix2.h" -#include "sparse2.h" -#include "zmatrix2.h" - - -#define errmesg(mesg) printf("Error: %s error: line %d\n",mesg,__LINE__) -#define notice(mesg) printf("# Testing %s...\n",mesg) - - -/* new types list */ - -extern MEM_CONNECT mem_connect[MEM_CONNECT_MAX_LISTS]; - -/* the number of a new list */ -#define FOO_LIST 1 - -/* numbers of types */ -#define TYPE_FOO_1 1 -#define TYPE_FOO_2 2 - -typedef struct { - int dim; - int fix_dim; - Real (*a)[10]; -} FOO_1; - -typedef struct { - int dim; - int fix_dim; - Real (*a)[2]; -} FOO_2; - - - -FOO_1 *foo_1_get(dim) -int dim; -{ - FOO_1 *f; - - if ((f = (FOO_1 *)malloc(sizeof(FOO_1))) == NULL) - error(E_MEM,"foo_1_get"); - else if (mem_info_is_on()) { - mem_bytes_list(TYPE_FOO_1,0,sizeof(FOO_1),FOO_LIST); - mem_numvar_list(TYPE_FOO_1,1,FOO_LIST); - } - - f->dim = dim; - f->fix_dim = 10; - if ((f->a = (Real (*)[10])malloc(dim*sizeof(Real [10]))) == NULL) - error(E_MEM,"foo_1_get"); - else if (mem_info_is_on()) - mem_bytes_list(TYPE_FOO_1,0,dim*sizeof(Real [10]),FOO_LIST); - - return f; -} - - -FOO_2 *foo_2_get(dim) -int dim; -{ - FOO_2 *f; - - if ((f = (FOO_2 *)malloc(sizeof(FOO_2))) == NULL) - error(E_MEM,"foo_2_get"); - else if (mem_info_is_on()) { - mem_bytes_list(TYPE_FOO_2,0,sizeof(FOO_2),FOO_LIST); - mem_numvar_list(TYPE_FOO_2,1,FOO_LIST); - } - - f->dim = dim; - f->fix_dim = 2; - if ((f->a = (Real (*)[2])malloc(dim*sizeof(Real [2]))) == NULL) - error(E_MEM,"foo_2_get"); - else if (mem_info_is_on()) - mem_bytes_list(TYPE_FOO_2,0,dim*sizeof(Real [2]),FOO_LIST); - - return f; -} - - - -int foo_1_free(f) -FOO_1 *f; -{ - if ( f != NULL) { - if (mem_info_is_on()) { - mem_bytes_list(TYPE_FOO_1,sizeof(FOO_1)+ - f->dim*sizeof(Real [10]),0,FOO_LIST); - mem_numvar_list(TYPE_FOO_1,-1,FOO_LIST); - } - - free(f->a); - free(f); - } - return 0; -} - -int foo_2_free(f) -FOO_2 *f; -{ - if ( f != NULL) { - if (mem_info_is_on()) { - mem_bytes_list(TYPE_FOO_2,sizeof(FOO_2)+ - f->dim*sizeof(Real [2]),0,FOO_LIST); - mem_numvar_list(TYPE_FOO_2,-1,FOO_LIST); - } - - free(f->a); - free(f); - } - return 0; -} - - - - -char *foo_type_name[] = { - "nothing", - "FOO_1", - "FOO_2" -}; - - -#define FOO_NUM_TYPES (sizeof(foo_type_name)/sizeof(*foo_type_name)) - - -int (*foo_free_func[FOO_NUM_TYPES])() = { - NULL, - foo_1_free, - foo_2_free - }; - - - -static MEM_ARRAY foo_info_sum[FOO_NUM_TYPES]; - - - - /* px_rand -- generates sort-of random permutation */ -PERM *px_rand(pi) -PERM *pi; -{ - int i, j, k; - - if ( ! pi ) - error(E_NULL,"px_rand"); - - for ( i = 0; i < 3*pi->size; i++ ) - { - j = (rand() >> 8) % pi->size; - k = (rand() >> 8) % pi->size; - px_transp(pi,j,k); - } - - return pi; -} - -#ifdef SPARSE -SPMAT *gen_non_symm(m,n) -int m, n; -{ - SPMAT *A; - static PERM *px = PNULL; - int i, j, k, k_max; - Real s1; - - A = sp_get(m,n,8); - px = px_resize(px,n); - MEM_STAT_REG(px,TYPE_PERM); - for ( i = 0; i < A->m; i++ ) - { - k_max = 1 + ((rand() >> 8) % 10); - for ( k = 0; k < k_max; k++ ) - { - j = (rand() >> 8) % A->n; - s1 = rand()/((double)MAX_RAND); - sp_set_val(A,i,j,s1); - } - } - /* to make it likely that A is nonsingular, use pivot... */ - for ( i = 0; i < 2*A->n; i++ ) - { - j = (rand() >> 8) % A->n; - k = (rand() >> 8) % A->n; - px_transp(px,j,k); - } - for ( i = 0; i < A->n; i++ ) - sp_set_val(A,i,px->pe[i],1.0); - - - return A; -} -#endif - -void stat_test1(par) -int par; -{ - static MAT *AT = MNULL; - static VEC *xt1 = VNULL, *yt1 = VNULL; - static VEC *xt2 = VNULL, *yt2 = VNULL; - static VEC *xt3 = VNULL, *yt3 = VNULL; - static VEC *xt4 = VNULL, *yt4 = VNULL; - - AT = m_resize(AT,10,10); - xt1 = v_resize(xt1,10); - yt1 = v_resize(yt1,10); - xt2 = v_resize(xt2,10); - yt2 = v_resize(yt2,10); - xt3 = v_resize(xt3,10); - yt3 = v_resize(yt3,10); - xt4 = v_resize(xt4,10); - yt4 = v_resize(yt4,10); - - MEM_STAT_REG(AT,TYPE_MAT); - -#ifdef ANSI_C - mem_stat_reg_vars(0,TYPE_VEC,&xt1,&xt2,&xt3,&xt4,&yt1, - &yt2,&yt3,&yt4,NULL); -#else -#ifdef VARARGS - mem_stat_reg_vars(0,TYPE_VEC,&xt1,&xt2,&xt3,&xt4,&yt1, - &yt2,&yt3,&yt4,NULL); -#else - MEM_STAT_REG(xt1,TYPE_VEC); - MEM_STAT_REG(yt1,TYPE_VEC); - MEM_STAT_REG(xt2,TYPE_VEC); - MEM_STAT_REG(yt2,TYPE_VEC); - MEM_STAT_REG(xt3,TYPE_VEC); - MEM_STAT_REG(yt3,TYPE_VEC); - MEM_STAT_REG(xt4,TYPE_VEC); - MEM_STAT_REG(yt4,TYPE_VEC); -#endif -#endif - - v_rand(xt1); - m_rand(AT); - mv_mlt(AT,xt1,yt1); - -} - - -void stat_test2(par) -int par; -{ - static PERM *px = PNULL; - static IVEC *ixt = IVNULL, *iyt = IVNULL; - - px = px_resize(px,10); - ixt = iv_resize(ixt,10); - iyt = iv_resize(iyt,10); - - MEM_STAT_REG(px,TYPE_PERM); - MEM_STAT_REG(ixt,TYPE_IVEC); - MEM_STAT_REG(iyt,TYPE_IVEC); - - px_rand(px); - px_inv(px,px); -} - -#ifdef SPARSE -void stat_test3(par) -int par; -{ - static SPMAT *AT = (SPMAT *)NULL; - static VEC *xt = VNULL, *yt = VNULL; - static SPROW *r = (SPROW *) NULL; - - if (AT == (SPMAT *)NULL) - AT = gen_non_symm(100,100); - else - AT = sp_resize(AT,100,100); - xt = v_resize(xt,100); - yt = v_resize(yt,100); - if (r == NULL) r = sprow_get(100); - - MEM_STAT_REG(AT,TYPE_SPMAT); - MEM_STAT_REG(xt,TYPE_VEC); - MEM_STAT_REG(yt,TYPE_VEC); - MEM_STAT_REG(r,TYPE_SPROW); - - v_rand(xt); - sp_mv_mlt(AT,xt,yt); - -} -#endif - -#ifdef COMPLEX -void stat_test4(par) -int par; -{ - static ZMAT *AT = ZMNULL; - static ZVEC *xt = ZVNULL, *yt = ZVNULL; - - AT = zm_resize(AT,10,10); - xt = zv_resize(xt,10); - yt = zv_resize(yt,10); - - MEM_STAT_REG(AT,TYPE_ZMAT); - MEM_STAT_REG(xt,TYPE_ZVEC); - MEM_STAT_REG(yt,TYPE_ZVEC); - - zv_rand(xt); - zm_rand(AT); - zmv_mlt(AT,xt,yt); - -} -#endif - - -void main(argc, argv) -int argc; -char *argv[]; -{ - VEC *x = VNULL, *y = VNULL, *z = VNULL; - PERM *pi1 = PNULL, *pi2 = PNULL, *pi3 = PNULL; - MAT *A = MNULL, *B = MNULL, *C = MNULL; -#ifdef SPARSE - SPMAT *sA, *sB; - SPROW *r; -#endif - IVEC *ix = IVNULL, *iy = IVNULL, *iz = IVNULL; - int m,n,i,j,deg,k; - Real s1,s2; -#ifdef COMPLEX - ZVEC *zx = ZVNULL, *zy = ZVNULL, *zz = ZVNULL; - ZMAT *zA = ZMNULL, *zB = ZMNULL, *zC = ZMNULL; - complex ONE; -#endif - /* variables for testing attaching new lists of types */ - FOO_1 *foo_1; - FOO_2 *foo_2; - - - mem_info_on(TRUE); - -#if defined(ANSI_C) || defined(VARARGS) - - notice("vector initialize, copy & resize"); - - n = v_get_vars(15,&x,&y,&z,(VEC **)NULL); - if (n != 3) { - errmesg("v_get_vars"); - printf(" n = %d (should be 3)\n",n); - } - - v_rand(x); - v_rand(y); - z = v_copy(x,z); - if ( v_norm2(v_sub(x,z,z)) >= MACHEPS ) - errmesg("v_get_vars"); - v_copy(x,y); - n = v_resize_vars(10,&x,&y,&z,NULL); - if ( n != 3 || v_norm2(v_sub(x,y,z)) >= MACHEPS ) - errmesg("VEC copy/resize"); - - n = v_resize_vars(20,&x,&y,&z,NULL); - if ( n != 3 || v_norm2(v_sub(x,y,z)) >= MACHEPS ) - errmesg("VEC resize"); - - n = v_free_vars(&x,&y,&z,NULL); - if (n != 3) - errmesg("v_free_vars"); - - /* IVEC */ - notice("int vector initialise, copy & resize"); - n = iv_get_vars(15,&ix,&iy,&iz,NULL); - - if (n != 3) { - errmesg("iv_get_vars"); - printf(" n = %d (should be 3)\n",n); - } - for (i=0; i < ix->dim; i++) { - ix->ive[i] = 2*i-1; - iy->ive[i] = 3*i+2; - } - iz = iv_add(ix,iy,iz); - for (i=0; i < ix->dim; i++) - if ( iz->ive[i] != 5*i+1) - errmesg("iv_get_vars"); - - n = iv_resize_vars(10,&ix,&iy,&iz,NULL); - if ( n != 3) errmesg("IVEC copy/resize"); - - iv_add(ix,iy,iz); - for (i=0; i < ix->dim; i++) - if (iz->ive[i] != 5*i+1) - errmesg("IVEC copy/resize"); - - n = iv_resize_vars(20,&ix,&iy,&iz,NULL); - if ( n != 3 ) errmesg("IVEC resize"); - - iv_add(ix,iy,iz); - for (i=0; i < 10; i++) - if (iz->ive[i] != 5*i+1) - errmesg("IVEC copy/resize"); - - n = iv_free_vars(&ix,&iy,&iz,NULL); - if (n != 3) - errmesg("iv_free_vars"); - - /* MAT */ - notice("matrix initialise, copy & resize"); - n = m_get_vars(10,10,&A,&B,&C,NULL); - if (n != 3) { - errmesg("m_get_vars"); - printf(" n = %d (should be 3)\n",n); - } - - m_rand(A); - m_rand(B); - C = m_copy(A,C); - if ( m_norm_inf(m_sub(A,C,C)) >= MACHEPS ) - errmesg("MAT copy"); - m_copy(A,B); - n = m_resize_vars(5,5,&A,&B,&C,NULL); - if ( n != 3 || m_norm_inf(m_sub(A,B,C)) >= MACHEPS ) - errmesg("MAT copy/resize"); - - n = m_resize_vars(20,20,&A,&B,NULL); - if ( m_norm_inf(m_sub(A,B,C)) >= MACHEPS ) - errmesg("MAT resize"); - - k = m_free_vars(&A,&B,&C,NULL); - if ( k != 3 ) - errmesg("MAT free"); - - /* PERM */ - notice("permutation initialise, inverting & permuting vectors"); - n = px_get_vars(15,&pi1,&pi2,&pi3,NULL); - if (n != 3) { - errmesg("px_get_vars"); - printf(" n = %d (should be 3)\n",n); - } - - v_get_vars(15,&x,&y,&z,NULL); - - px_rand(pi1); - v_rand(x); - px_vec(pi1,x,z); - y = v_resize(y,x->dim); - pxinv_vec(pi1,z,y); - if ( v_norm2(v_sub(x,y,z)) >= MACHEPS ) - errmesg("PERMute vector"); - pi2 = px_inv(pi1,pi2); - pi3 = px_mlt(pi1,pi2,pi3); - for ( i = 0; i < pi3->size; i++ ) - if ( pi3->pe[i] != i ) - errmesg("PERM inverse/multiply"); - - px_resize_vars(20,&pi1,&pi2,&pi3,NULL); - v_resize_vars(20,&x,&y,&z,NULL); - - px_rand(pi1); - v_rand(x); - px_vec(pi1,x,z); - pxinv_vec(pi1,z,y); - if ( v_norm2(v_sub(x,y,z)) >= MACHEPS ) - errmesg("PERMute vector"); - pi2 = px_inv(pi1,pi2); - pi3 = px_mlt(pi1,pi2,pi3); - for ( i = 0; i < pi3->size; i++ ) - if ( pi3->pe[i] != i ) - errmesg("PERM inverse/multiply"); - - n = px_free_vars(&pi1,&pi2,&pi3,NULL); - if ( n != 3 ) - errmesg("PERM px_free_vars"); - -#ifdef SPARSE - /* set up two random sparse matrices */ - m = 120; - n = 100; - deg = 5; - notice("allocating sparse matrices"); - k = sp_get_vars(m,n,deg,&sA,&sB,NULL); - if (k != 2) { - errmesg("sp_get_vars"); - printf(" n = %d (should be 2)\n",k); - } - - notice("setting and getting matrix entries"); - for ( k = 0; k < m*deg; k++ ) - { - i = (rand() >> 8) % m; - j = (rand() >> 8) % n; - sp_set_val(sA,i,j,rand()/((Real)MAX_RAND)); - i = (rand() >> 8) % m; - j = (rand() >> 8) % n; - sp_set_val(sB,i,j,rand()/((Real)MAX_RAND)); - } - for ( k = 0; k < 10; k++ ) - { - s1 = rand()/((Real)MAX_RAND); - i = (rand() >> 8) % m; - j = (rand() >> 8) % n; - sp_set_val(sA,i,j,s1); - s2 = sp_get_val(sA,i,j); - if ( fabs(s1 - s2) >= MACHEPS ) { - printf(" s1 = %g, s2 = %g, |s1 - s2| = %g\n", - s1,s2,fabs(s1-s2)); - break; - } - } - if ( k < 10 ) - errmesg("sp_set_val()/sp_get_val()"); - - /* check column access paths */ - notice("resizing and access paths"); - k = sp_resize_vars(sA->m+10,sA->n+10,&sA,&sB,NULL); - if (k != 2) { - errmesg("sp_get_vars"); - printf(" n = %d (should be 2)\n",k); - } - - for ( k = 0 ; k < 20; k++ ) - { - i = sA->m - 1 - ((rand() >> 8) % 10); - j = sA->n - 1 - ((rand() >> 8) % 10); - s1 = rand()/((Real)MAX_RAND); - sp_set_val(sA,i,j,s1); - if ( fabs(s1 - sp_get_val(sA,i,j)) >= MACHEPS ) - break; - } - if ( k < 20 ) - errmesg("sp_resize()"); - sp_col_access(sA); - if ( ! chk_col_access(sA) ) - { - errmesg("sp_col_access()"); - } - sp_diag_access(sA); - for ( i = 0; i < sA->m; i++ ) - { - r = &(sA->row[i]); - if ( r->diag != sprow_idx(r,i) ) - break; - } - if ( i < sA->m ) - { - errmesg("sp_diag_access()"); - } - - k = sp_free_vars(&sA,&sB,NULL); - if (k != 2) - errmesg("sp_free_vars"); -#endif /* SPARSE */ - - -#ifdef COMPLEX - /* complex stuff */ - - ONE = zmake(1.0,0.0); - printf("# ONE = "); z_output(ONE); - printf("# Check: MACHEPS = %g\n",MACHEPS); - /* allocate, initialise, copy and resize operations */ - /* ZVEC */ - notice("vector initialise, copy & resize"); - zv_get_vars(12,&zx,&zy,&zz,NULL); - - zv_rand(zx); - zv_rand(zy); - zz = zv_copy(zx,zz); - if ( zv_norm2(zv_sub(zx,zz,zz)) >= MACHEPS ) - errmesg("ZVEC copy"); - zv_copy(zx,zy); - - zv_resize_vars(10,&zx,&zy,NULL); - if ( zv_norm2(zv_sub(zx,zy,zz)) >= MACHEPS ) - errmesg("ZVEC copy/resize"); - - zv_resize_vars(20,&zx,&zy,NULL); - if ( zv_norm2(zv_sub(zx,zy,zz)) >= MACHEPS ) - errmesg("VZEC resize"); - zv_free_vars(&zx,&zy,&zz,NULL); - - - /* ZMAT */ - notice("matrix initialise, copy & resize"); - zm_get_vars(8,5,&zA,&zB,&zC,NULL); - - zm_rand(zA); - zm_rand(zB); - zC = zm_copy(zA,zC); - if ( zm_norm_inf(zm_sub(zA,zC,zC)) >= MACHEPS ) - errmesg("ZMAT copy"); - - zm_copy(zA,zB); - zm_resize_vars(3,5,&zA,&zB,&zC,NULL); - - if ( zm_norm_inf(zm_sub(zA,zB,zC)) >= MACHEPS ) - errmesg("ZMAT copy/resize"); - zm_resize_vars(20,20,&zA,&zB,&zC,NULL); - - if ( zm_norm_inf(zm_sub(zA,zB,zC)) >= MACHEPS ) - errmesg("ZMAT resize"); - - zm_free_vars(&zA,&zB,&zC,NULL); -#endif /* COMPLEX */ - -#endif /* if defined(ANSI_C) || defined(VARARGS) */ - - printf("# test of mem_info_bytes and mem_info_numvar\n"); - printf(" TYPE VEC: %ld bytes allocated, %d variables allocated\n", - mem_info_bytes(TYPE_VEC,0),mem_info_numvar(TYPE_VEC,0)); - - notice("static memory test"); - mem_info_on(TRUE); - mem_stat_mark(1); - for (i=0; i < 100; i++) - stat_test1(i); - mem_stat_free(1); - - mem_stat_mark(1); - for (i=0; i < 100; i++) { - stat_test1(i); -#ifdef COMPLEX - stat_test4(i); -#endif - } - - mem_stat_mark(2); - for (i=0; i < 100; i++) - stat_test2(i); - - mem_stat_mark(3); -#ifdef SPARSE - for (i=0; i < 100; i++) - stat_test3(i); -#endif - - mem_info(); - mem_dump_list(stdout,0); - - mem_stat_free(1); - mem_stat_free(3); - mem_stat_mark(4); - - for (i=0; i < 100; i++) { - stat_test1(i); -#ifdef COMPLEX - stat_test4(i); -#endif - } - - mem_stat_dump(stdout,0); - if (mem_stat_show_mark() != 4) { - errmesg("not 4 in mem_stat_show_mark()"); - } - - mem_stat_free(2); - mem_stat_free(4); - - if (mem_stat_show_mark() != 0) { - errmesg("not 0 in mem_stat_show_mark()"); - } - - /* add new list of types */ - - mem_attach_list(FOO_LIST,FOO_NUM_TYPES,foo_type_name, - foo_free_func,foo_info_sum); - if (!mem_is_list_attached(FOO_LIST)) - errmesg("list FOO_LIST is not attached"); - - mem_dump_list(stdout,FOO_LIST); - foo_1 = foo_1_get(6); - foo_2 = foo_2_get(3); - for (i=0; i < foo_1->dim; i++) - for (j=0; j < foo_1->fix_dim; j++) - foo_1->a[i][j] = i+j; - for (i=0; i < foo_2->dim; i++) - for (j=0; j < foo_2->fix_dim; j++) - foo_2->a[i][j] = i+j; - printf(" foo_1->a[%d][%d] = %g\n",5,9,foo_1->a[5][9]); - printf(" foo_2->a[%d][%d] = %g\n",2,1,foo_2->a[2][1]); - - mem_stat_mark(5); - mem_stat_reg_list((void **)&foo_1,TYPE_FOO_1,FOO_LIST); - mem_stat_reg_list((void **)&foo_2,TYPE_FOO_2,FOO_LIST); - mem_stat_dump(stdout,FOO_LIST); - mem_info_file(stdout,FOO_LIST); - mem_stat_free_list(5,FOO_LIST); - mem_stat_dump(stdout,FOO_LIST); - if ( foo_1 != NULL ) - errmesg(" foo_1 is not released"); - if ( foo_2 != NULL ) - errmesg(" foo_2 is not released"); - mem_dump_list(stdout,FOO_LIST); - mem_info_file(stdout,FOO_LIST); - - mem_free_vars(FOO_LIST); - if ( mem_is_list_attached(FOO_LIST) ) - errmesg("list FOO_LIST is not detached"); - - mem_info(); - -#if REAL == FLOAT - printf("# SINGLE PRECISION was used\n"); -#elif REAL == DOUBLE - printf("# DOUBLE PRECISION was used\n"); -#endif - -#define ANSI_OR_VAR - -#ifndef ANSI_C -#ifndef VARARGS -#undef ANSI_OR_VAR -#endif -#endif - -#ifdef ANSI_OR_VAR - - printf("# you should get: \n"); -#if (REAL == FLOAT) - printf("# type VEC: 276 bytes allocated, 3 variables allocated\n"); -#elif (REAL == DOUBLE) - printf("# type VEC: 516 bytes allocated, 3 variables allocated\n"); -#endif - printf("# and other types are zeros\n"); - -#endif /*#if defined(ANSI_C) || defined(VARAGS) */ - - printf("# Finished memory torture test\n"); - return; -} //GO.SYSIN DD memtort.c echo itertort.c 1>&2 sed >itertort.c <<'//GO.SYSIN DD itertort.c' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -/* iter_tort.c 16/09/93 */ - -/* - This file contains tests for the iterative part of Meschach -*/ - -#include <stdio.h> -#include <math.h> -#include "matrix2.h" -#include "sparse2.h" -#include "iter.h" - -#define errmesg(mesg) printf("Error: %s error: line %d\n",mesg,__LINE__) -#define notice(mesg) printf("# Testing %s...\n",mesg); - - /* for iterative methods */ - -#if REAL == DOUBLE -#define EPS 1e-7 -#define KK 20 -#elif REAL == FLOAT -#define EPS 1e-5 -#define KK 8 -#endif - -#define ANON 513 -#define ASYM ANON - - -static VEC *ex_sol = VNULL; - -/* new iter information */ -void iter_mod_info(ip,nres,res,Bres) -ITER *ip; -double nres; -VEC *res, *Bres; -{ - static VEC *tmp; - - if (ip->b == VNULL) return; - tmp = v_resize(tmp,ip->b->dim); - MEM_STAT_REG(tmp,TYPE_VEC); - - if (nres >= 0.0) { - printf(" %d. residual = %g\n",ip->steps,nres); - } - else - printf(" %d. residual = %g (WARNING !!! should be >= 0) \n", - ip->steps,nres); - if (ex_sol != VNULL) - printf(" ||u_ex - u_approx||_2 = %g\n", - v_norm2(v_sub(ip->x,ex_sol,tmp))); -} - - -/* out = A^T*A*x */ -VEC *norm_equ(A,x,out) -SPMAT *A; -VEC *x, *out; -{ - static VEC * tmp; - - tmp = v_resize(tmp,x->dim); - MEM_STAT_REG(tmp,TYPE_VEC); - sp_mv_mlt(A,x,tmp); - sp_vm_mlt(A,tmp,out); - return out; - -} - - -/* - make symmetric preconditioner for nonsymmetric matrix A; - B = 0.5*(A+A^T) and then B is factorized using - incomplete Choleski factorization -*/ - -SPMAT *gen_sym_precond(A) -SPMAT *A; -{ - SPMAT *B; - SPROW *row; - int i,j,k; - Real val; - - B = sp_get(A->m,A->n,A->row[0].maxlen); - for (i=0; i < A->m; i++) { - row = &(A->row[i]); - for (j = 0; j < row->len; j++) { - k = row->elt[j].col; - if (i != k) { - val = 0.5*(sp_get_val(A,i,k) + sp_get_val(A,k,i)); - sp_set_val(B,i,k,val); - sp_set_val(B,k,i,val); - } - else { /* i == k */ - val = sp_get_val(A,i,i); - sp_set_val(B,i,i,val); - } - } - } - - spICHfactor(B); - return B; -} - -/* Dv_mlt -- diagonal by vector multiply; the diagonal matrix is represented - by a vector d */ -VEC *Dv_mlt(d, x, out) -VEC *d, *x, *out; -{ - int i; - - if ( ! d || ! x ) - error(E_NULL,"Dv_mlt"); - if ( d->dim != x->dim ) - error(E_SIZES,"Dv_mlt"); - out = v_resize(out,x->dim); - - for ( i = 0; i < x->dim; i++ ) - out->ve[i] = d->ve[i]*x->ve[i]; - - return out; -} - - - -/************************************************/ -void main(argc, argv) -int argc; -char *argv[]; -{ - VEC *x, *y, *z, *u, *v, *xn, *yn; - SPMAT *A = NULL, *B = NULL; - SPMAT *An = NULL, *Bn = NULL; - int i, k, kk, j; - ITER *ips, *ips1, *ipns, *ipns1; - MAT *Q, *H, *Q1, *H1; - VEC vt, vt1; - Real hh; - - - mem_info_on(TRUE); - notice("allocating sparse matrices"); - - printf(" dim of A = %dx%d\n",ASYM,ASYM); - - A = iter_gen_sym(ASYM,8); - B = sp_copy(A); - spICHfactor(B); - - u = v_get(A->n); - x = v_get(A->n); - y = v_get(A->n); - v = v_get(A->n); - - v_rand(x); - sp_mv_mlt(A,x,y); - ex_sol = x; - - notice(" initialize ITER variables"); - /* ips for symmetric matrices with precondition */ - ips = iter_get(A->m,A->n); - - /* printf(" ips:\n"); - iter_dump(stdout,ips); */ - - ips->limit = 500; - ips->eps = EPS; - - iter_Ax(ips,sp_mv_mlt,A); - iter_Bx(ips,spCHsolve,B); - - ips->b = v_copy(y,ips->b); - v_rand(ips->x); - /* test of iter_resize */ - ips = iter_resize(ips,2*A->m,2*A->n); - ips = iter_resize(ips,A->m,A->n); - - /* printf(" ips:\n"); - iter_dump(stdout,ips); */ - - /* ips1 for symmetric matrices without precondition */ - ips1 = iter_get(0,0); - /* printf(" ips1:\n"); - iter_dump(stdout,ips1); */ - ITER_FREE(ips1); - - ips1 = iter_copy2(ips,ips1); - iter_Bx(ips1,NULL,NULL); - ips1->b = ips->b; - ips1->shared_b = TRUE; - /* printf(" ips1:\n"); - iter_dump(stdout,ips1); */ - - /* ipns for nonsymetric matrices with precondition */ - ipns = iter_copy(ips,INULL); - ipns->k = KK; - ipns->limit = 500; - ipns->info = NULL; - - An = iter_gen_nonsym_posdef(ANON,8); - Bn = gen_sym_precond(An); - xn = v_get(An->n); - yn = v_get(An->n); - v_rand(xn); - sp_mv_mlt(An,xn,yn); - ipns->b = v_copy(yn,ipns->b); - - iter_Ax(ipns, sp_mv_mlt,An); - iter_ATx(ipns, sp_vm_mlt,An); - iter_Bx(ipns, spCHsolve,Bn); - - /* printf(" ipns:\n"); - iter_dump(stdout,ipns); */ - - /* ipns1 for nonsymmetric matrices without precondition */ - ipns1 = iter_copy2(ipns,INULL); - ipns1->b = ipns->b; - ipns1->shared_b = TRUE; - iter_Bx(ipns1,NULL,NULL); - - /* printf(" ipns1:\n"); - iter_dump(stdout,ipns1); */ - - - /******* CG ********/ - - notice(" CG method without preconditioning"); - ips1->info = NULL; - mem_stat_mark(1); - iter_cg(ips1); - - k = ips1->steps; - z = ips1->x; - printf(" cg: no. of iter.steps = %d\n",k); - v_sub(z,x,u); - printf(" (cg:) ||u_ex - u_approx||_2 = %g [EPS = %g]\n", - v_norm2(u),EPS); - - notice(" CG method with ICH preconditioning"); - - ips->info = NULL; - v_zero(ips->x); - iter_cg(ips); - - k = ips->steps; - printf(" cg: no. of iter.steps = %d\n",k); - v_sub(ips->x,x,u); - printf(" (cg:) ||u_ex - u_approx||_2 = %g [EPS = %g]\n", - v_norm2(u),EPS); - - V_FREE(v); - if ((v = iter_spcg(A,B,y,EPS,VNULL,1000,&k)) == VNULL) - errmesg("CG method with precond.: NULL solution"); - - v_sub(ips->x,v,u); - if (v_norm2(u) >= EPS) { - errmesg("CG method with precond.: different solutions"); - printf(" diff. = %g\n",v_norm2(u)); - } - - - mem_stat_free(1); - printf(" spcg: # of iter. steps = %d\n",k); - v_sub(v,x,u); - printf(" (spcg:) ||u_ex - u_approx||_2 = %g [EPS = %g]\n", - v_norm2(u),EPS); - - - /*** CG FOR NORMAL EQUATION *****/ - - notice("CGNE method with ICH preconditioning (nonsymmetric case)"); - - /* ipns->info = iter_std_info; */ - ipns->info = NULL; - v_zero(ipns->x); - - mem_stat_mark(1); - iter_cgne(ipns); - - k = ipns->steps; - z = ipns->x; - printf(" cgne: no. of iter.steps = %d\n",k); - v_sub(z,xn,u); - printf(" (cgne:) ||u_ex - u_approx||_2 = %g [EPS = %g]\n", - v_norm2(u),EPS); - - notice("CGNE method without preconditioning (nonsymmetric case)"); - - v_rand(u); - u = iter_spcgne(An,NULL,yn,EPS,u,1000,&k); - - mem_stat_free(1); - printf(" spcgne: no. of iter.steps = %d\n",k); - v_sub(u,xn,u); - printf(" (spcgne:) ||u_ex - u_approx||_2 = %g [EPS = %g]\n", - v_norm2(u),EPS); - - /*** CGS *****/ - - notice("CGS method with ICH preconditioning (nonsymmetric case)"); - - v_zero(ipns->x); /* new init guess == 0 */ - - mem_stat_mark(1); - ipns->info = NULL; - v_rand(u); - iter_cgs(ipns,u); - - k = ipns->steps; - z = ipns->x; - printf(" cgs: no. of iter.steps = %d\n",k); - v_sub(z,xn,u); - printf(" (cgs:) ||u_ex - u_approx||_2 = %g [EPS = %g]\n", - v_norm2(u),EPS); - - notice("CGS method without preconditioning (nonsymmetric case)"); - - v_rand(u); - v_rand(v); - v = iter_spcgs(An,NULL,yn,u,EPS,v,1000,&k); - - mem_stat_free(1); - printf(" cgs: no. of iter.steps = %d\n",k); - v_sub(v,xn,u); - printf(" (cgs:) ||u_ex - u_approx||_2 = %g [EPS = %g]\n", - v_norm2(u),EPS); - - - - /*** LSQR ***/ - - notice("LSQR method (without preconditioning)"); - - v_rand(u); - v_free(ipns1->x); - ipns1->x = u; - ipns1->shared_x = TRUE; - ipns1->info = NULL; - mem_stat_mark(2); - z = iter_lsqr(ipns1); - - v_sub(xn,z,v); - k = ipns1->steps; - printf(" lsqr: # of iter. steps = %d\n",k); - printf(" (lsqr:) ||u_ex - u_approx||_2 = %g [EPS = %g]\n", - v_norm2(v),EPS); - - v_rand(u); - u = iter_splsqr(An,yn,EPS,u,1000,&k); - mem_stat_free(2); - - v_sub(xn,u,v); - printf(" splsqr: # of iter. steps = %d\n",k); - printf(" (splsqr:) ||u_ex - u_approx||_2 = %g [EPS = %g]\n", - v_norm2(v),EPS); - - - - /***** GMRES ********/ - - notice("GMRES method with ICH preconditioning (nonsymmetric case)"); - - v_zero(ipns->x); -/* ipns->info = iter_std_info; */ - ipns->info = NULL; - - mem_stat_mark(2); - z = iter_gmres(ipns); - v_sub(xn,z,v); - k = ipns->steps; - printf(" gmres: # of iter. steps = %d\n",k); - printf(" (gmres:) ||u_ex - u_approx||_2 = %g [EPS = %g]\n", - v_norm2(v),EPS); - - notice("GMRES method without preconditioning (nonsymmetric case)"); - V_FREE(v); - v = iter_spgmres(An,NULL,yn,EPS,VNULL,10,1004,&k); - mem_stat_free(2); - - v_sub(xn,v,v); - printf(" spgmres: # of iter. steps = %d\n",k); - printf(" (spgmres:) ||u_ex - u_approx||_2 = %g [EPS = %g]\n", - v_norm2(v),EPS); - - - - /**** MGCR *****/ - - notice("MGCR method with ICH preconditioning (nonsymmetric case)"); - - v_zero(ipns->x); - mem_stat_mark(2); - z = iter_mgcr(ipns); - v_sub(xn,z,v); - k = ipns->steps; - printf(" mgcr: # of iter. steps = %d\n",k); - printf(" (mgcr:) ||u_ex - u_approx||_2 = %g [EPS = %g]\n", - v_norm2(v),EPS); - - notice("MGCR method without preconditioning (nonsymmetric case)"); - V_FREE(v); - v = iter_spmgcr(An,NULL,yn,EPS,VNULL,10,1004,&k); - mem_stat_free(2); - - v_sub(xn,v,v); - printf(" spmgcr: # of iter. steps = %d\n",k); - printf(" (spmgcr:) ||u_ex - u_approx||_2 = %g [EPS = %g]\n", - v_norm2(v),EPS); - - - /***** ARNOLDI METHOD ********/ - - - notice("arnoldi method"); - - kk = ipns1->k = KK; - Q = m_get(kk,x->dim); - Q1 = m_get(kk,x->dim); - H = m_get(kk,kk); - v_rand(u); - ipns1->x = u; - ipns1->shared_x = TRUE; - mem_stat_mark(3); - iter_arnoldi_iref(ipns1,&hh,Q,H); - mem_stat_free(3); - - /* check the equality: - Q*A*Q^T = H; */ - - vt.dim = vt.max_dim = x->dim; - vt1.dim = vt1.max_dim = x->dim; - for (j=0; j < kk; j++) { - vt.ve = Q->me[j]; - vt1.ve = Q1->me[j]; - sp_mv_mlt(An,&vt,&vt1); - } - H1 = m_get(kk,kk); - mmtr_mlt(Q,Q1,H1); - m_sub(H,H1,H1); - if (m_norm_inf(H1) > MACHEPS*x->dim) - printf(" (arnoldi_iref) ||Q*A*Q^T - H|| = %g [cf. MACHEPS = %g]\n", - m_norm_inf(H1),MACHEPS); - - /* check Q*Q^T = I */ - - mmtr_mlt(Q,Q,H1); - for (j=0; j < kk; j++) - H1->me[j][j] -= 1.0; - if (m_norm_inf(H1) > MACHEPS*x->dim) - printf(" (arnoldi_iref) ||Q*Q^T - I|| = %g [cf. MACHEPS = %g]\n", - m_norm_inf(H1),MACHEPS); - - ipns1->x = u; - ipns1->shared_x = TRUE; - mem_stat_mark(3); - iter_arnoldi(ipns1,&hh,Q,H); - mem_stat_free(3); - - /* check the equality: - Q*A*Q^T = H; */ - - vt.dim = vt.max_dim = x->dim; - vt1.dim = vt1.max_dim = x->dim; - for (j=0; j < kk; j++) { - vt.ve = Q->me[j]; - vt1.ve = Q1->me[j]; - sp_mv_mlt(An,&vt,&vt1); - } - - mmtr_mlt(Q,Q1,H1); - m_sub(H,H1,H1); - if (m_norm_inf(H1) > MACHEPS*x->dim) - printf(" (arnoldi) ||Q*A*Q^T - H|| = %g [cf. MACHEPS = %g]\n", - m_norm_inf(H1),MACHEPS); - /* check Q*Q^T = I */ - mmtr_mlt(Q,Q,H1); - for (j=0; j < kk; j++) - H1->me[j][j] -= 1.0; - if (m_norm_inf(H1) > MACHEPS*x->dim) - printf(" (arnoldi) ||Q*Q^T - I|| = %g [cf. MACHEPS = %g]\n", - m_norm_inf(H1),MACHEPS); - - v_rand(u); - mem_stat_mark(3); - iter_sparnoldi(An,u,kk,&hh,Q,H); - mem_stat_free(3); - - /* check the equality: - Q*A*Q^T = H; */ - - vt.dim = vt.max_dim = x->dim; - vt1.dim = vt1.max_dim = x->dim; - for (j=0; j < kk; j++) { - vt.ve = Q->me[j]; - vt1.ve = Q1->me[j]; - sp_mv_mlt(An,&vt,&vt1); - } - - mmtr_mlt(Q,Q1,H1); - m_sub(H,H1,H1); - if (m_norm_inf(H1) > MACHEPS*x->dim) - printf(" (sparnoldi) ||Q*A*Q^T - H|| = %g [cf. MACHEPS = %g]\n", - m_norm_inf(H1),MACHEPS); - /* check Q*Q^T = I */ - mmtr_mlt(Q,Q,H1); - for (j=0; j < kk; j++) - H1->me[j][j] -= 1.0; - if (m_norm_inf(H1) > MACHEPS*x->dim) - printf(" (sparnoldi) ||Q*Q^T - I|| = %g [cf. MACHEPS = %g]\n", - m_norm_inf(H1),MACHEPS); - - - - /****** LANCZOS METHOD ******/ - - notice("lanczos method"); - kk = ipns1->k; - Q = m_resize(Q,kk,x->dim); - Q1 = m_resize(Q1,kk,x->dim); - H = m_resize(H,kk,kk); - ips1->k = kk; - v_rand(u); - v_free(ips1->x); - ips1->x = u; - ips1->shared_x = TRUE; - - mem_stat_mark(3); - iter_lanczos(ips1,x,y,&hh,Q); - mem_stat_free(3); - - /* check the equality: - Q*A*Q^T = H; */ - - vt.dim = vt1.dim = Q->n; - vt.max_dim = vt1.max_dim = Q->max_n; - Q1 = m_resize(Q1,Q->m,Q->n); - for (j=0; j < Q->m; j++) { - vt.ve = Q->me[j]; - vt1.ve = Q1->me[j]; - sp_mv_mlt(A,&vt,&vt1); - } - H1 = m_resize(H1,Q->m,Q->m); - H = m_resize(H,Q->m,Q->m); - mmtr_mlt(Q,Q1,H1); - - m_zero(H); - for (j=0; j < Q->m-1; j++) { - H->me[j][j] = x->ve[j]; - H->me[j][j+1] = H->me[j+1][j] = y->ve[j]; - } - H->me[Q->m-1][Q->m-1] = x->ve[Q->m-1]; - - m_sub(H,H1,H1); - if (m_norm_inf(H1) > MACHEPS*x->dim) - printf(" (lanczos) ||Q*A*Q^T - H|| = %g [cf. MACHEPS = %g]\n", - m_norm_inf(H1),MACHEPS); - - /* check Q*Q^T = I */ - - mmtr_mlt(Q,Q,H1); - for (j=0; j < Q->m; j++) - H1->me[j][j] -= 1.0; - if (m_norm_inf(H1) > MACHEPS*x->dim) - printf(" (lanczos) ||Q*Q^T - I|| = %g [cf. MACHEPS = %g]\n", - m_norm_inf(H1),MACHEPS); - - mem_stat_mark(3); - v_rand(u); - iter_splanczos(A,kk,u,x,y,&hh,Q); - mem_stat_free(3); - - /* check the equality: - Q*A*Q^T = H; */ - - vt.dim = vt1.dim = Q->n; - vt.max_dim = vt1.max_dim = Q->max_n; - Q1 = m_resize(Q1,Q->m,Q->n); - for (j=0; j < Q->m; j++) { - vt.ve = Q->me[j]; - vt1.ve = Q1->me[j]; - sp_mv_mlt(A,&vt,&vt1); - } - H1 = m_resize(H1,Q->m,Q->m); - H = m_resize(H,Q->m,Q->m); - mmtr_mlt(Q,Q1,H1); - for (j=0; j < Q->m-1; j++) { - H->me[j][j] = x->ve[j]; - H->me[j][j+1] = H->me[j+1][j] = y->ve[j]; - } - H->me[Q->m-1][Q->m-1] = x->ve[Q->m-1]; - - m_sub(H,H1,H1); - if (m_norm_inf(H1) > MACHEPS*x->dim) - printf(" (splanczos) ||Q*A*Q^T - H|| = %g [cf. MACHEPS = %g]\n", - m_norm_inf(H1),MACHEPS); - /* check Q*Q^T = I */ - mmtr_mlt(Q,Q,H1); - for (j=0; j < Q->m; j++) - H1->me[j][j] -= 1.0; - if (m_norm_inf(H1) > MACHEPS*x->dim) - printf(" (splanczos) ||Q*Q^T - I|| = %g [cf. MACHEPS = %g]\n", - m_norm_inf(H1),MACHEPS); - - - - /***** LANCZOS2 ****/ - - notice("lanczos2 method"); - kk = 50; /* # of dir. vectors */ - ips1->k = kk; - v_rand(u); - ips1->x = u; - ips1->shared_x = TRUE; - - for ( i = 0; i < xn->dim; i++ ) - xn->ve[i] = i; - iter_Ax(ips1,Dv_mlt,xn); - mem_stat_mark(3); - iter_lanczos2(ips1,y,v); - mem_stat_free(3); - - printf("# Number of steps of Lanczos algorithm = %d\n", kk); - printf("# Exact eigenvalues are 0, 1, 2, ..., %d\n",ANON-1); - printf("# Extreme eigenvalues should be accurate; \n"); - printf("# interior values usually are not.\n"); - printf("# approx e-vals =\n"); v_output(y); - printf("# Error in estimate of bottom e-vec (Lanczos) = %g\n", - fabs(v->ve[0])); - - mem_stat_mark(3); - v_rand(u); - iter_splanczos2(A,kk,u,y,v); - mem_stat_free(3); - - - /***** FINISHING *******/ - - notice("release ITER variables"); - - M_FREE(Q); - M_FREE(Q1); - M_FREE(H); - M_FREE(H1); - - ITER_FREE(ipns); - ITER_FREE(ips); - ITER_FREE(ipns1); - ITER_FREE(ips1); - SP_FREE(A); - SP_FREE(B); - SP_FREE(An); - SP_FREE(Bn); - - V_FREE(x); - V_FREE(y); - V_FREE(u); - V_FREE(v); - V_FREE(xn); - V_FREE(yn); - - printf("# Done testing (%s)\n",argv[0]); - mem_info(); -} //GO.SYSIN DD itertort.c echo mfuntort.c 1>&2 sed >mfuntort.c <<'//GO.SYSIN DD mfuntort.c' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -/* mfuntort.c, 10/11/93 */ - -static char rcsid[] = "$Id: mfuntort.c,v 1.2 1994/01/14 01:08:06 des Exp $"; - -#include <stdio.h> -#include <math.h> -#include "matrix.h" -#include "matrix2.h" - - -#define errmesg(mesg) printf("Error: %s error: line %d\n",mesg,__LINE__) -#define notice(mesg) printf("# Testing %s...\n",mesg); - -#define DIM 10 - -void main() -{ - - MAT *A, *B, *C, *OUTA, *OUTB, *TMP; - MAT *exp_A_expected, *exp_A; - VEC *x, *b; - double c, eps = 1e-10; - int i, j, q_out, j_out; - - mem_info_on(TRUE); - - A = m_get(DIM,DIM); - B = m_get(DIM,DIM); - C = m_get(DIM,DIM); - OUTA = m_get(DIM,DIM); - OUTB = m_get(DIM,DIM); - TMP = m_get(DIM,DIM); - x = v_get(DIM); - b = v_get(6); - - notice("exponent of a matrix"); - - m_ident(A); - mem_stat_mark(1); - _m_exp(A,eps,OUTA,&q_out,&j_out); - printf("# q_out = %d, j_out = %d\n",q_out,j_out); - - m_exp(A,eps,OUTA); - sm_mlt(exp(1.0),A,A); - m_sub(OUTA,A,TMP); - printf("# ||exp(I) - e*I|| = %g\n",m_norm_inf(TMP)); - - m_rand(A); - m_transp(A,TMP); - m_add(A,TMP,A); - B = m_copy(A,B); - - m_exp(A,eps,OUTA); - - symmeig(B,OUTB,x); - m_zero(TMP); - for (i=0; i < x->dim; i++) - TMP->me[i][i] = exp(x->ve[i]); - m_mlt(OUTB,TMP,C); - mmtr_mlt(C,OUTB,TMP); - m_sub(TMP,OUTA,TMP); - printf("# ||exp(A) - Q*exp(lambda)*Q^T|| = %g\n",m_norm_inf(TMP)); - - notice("polynomial of a matrix"); - m_rand(A); - m_transp(A,TMP); - m_add(A,TMP,A); - B = m_copy(A,B); - v_rand(b); - - m_poly(A,b,OUTA); - - symmeig(B,OUTB,x); - m_zero(TMP); - for (i=0; i < x->dim; i++) { - c = b->ve[b->dim-1]; - for (j=b->dim-2; j >= 0; j--) - c = c*x->ve[i] + b->ve[j]; - TMP->me[i][i] = c; - } - m_mlt(OUTB,TMP,C); - mmtr_mlt(C,OUTB,TMP); - m_sub(TMP,OUTA,TMP); - printf("# ||poly(A) - Q*poly(lambda)*Q^T|| = %g\n",m_norm_inf(TMP)); - mem_stat_free(1); - - - /* Brook Milligan's test */ - - M_FREE(A); - M_FREE(B); - M_FREE(C); - - notice("exponent of a nonsymmetric matrix"); - A = m_get (2, 2); - A -> me [0][0] = 1.0; - A -> me [0][1] = 1.0; - A -> me [1][0] = 4.0; - A -> me [1][1] = 1.0; - - exp_A_expected = m_get(2, 2); - exp_A_expected -> me [0][0] = exp (3.0) / 2.0 + exp (-1.0) / 2.0; - exp_A_expected -> me [0][1] = exp (3.0) / 4.0 - exp (-1.0) / 4.0; - exp_A_expected -> me [1][0] = exp (3.0) - exp (-1.0); - exp_A_expected -> me [1][1] = exp (3.0) / 2.0 + exp (-1.0) / 2.0; - - printf ("A:\n"); - for (i = 0; i < 2; i++) - { - for (j = 0; j < 2; j++) - printf (" %15.8e", A -> me [i][j]); - printf ("\n"); - } - - printf ("\nexp(A) (expected):\n"); - for (i = 0; i < 2; i++) - { - for (j = 0; j < 2; j++) - printf (" %15.8e", exp_A_expected -> me [i][j]); - printf ("\n"); - } - - mem_stat_mark(3); - exp_A = m_exp (A, 1e-16,NULL); - mem_stat_free(3); - - printf ("\nexp(A):\n"); - for (i = 0; i < 2; i++) - { - for (j = 0; j < 2; j++) - printf (" %15.8e", exp_A -> me [i][j]); - printf ("\n"); - } - printf ("\nexp(A) - exp(A) (expected):\n"); - for (i = 0; i < 2; i++) - { - for (j = 0; j < 2; j++) - printf (" %15.8e", exp_A -> me [i][j] - exp_A_expected -> me [i][j]); - printf ("\n"); - } - - M_FREE(A); - M_FREE(B); - M_FREE(C); - M_FREE(exp_A); - M_FREE(exp_A_expected); - M_FREE(OUTA); - M_FREE(OUTB); - M_FREE(TMP); - V_FREE(b); - V_FREE(x); - - mem_info(); -} - //GO.SYSIN DD mfuntort.c echo iotort.c 1>&2 sed >iotort.c <<'//GO.SYSIN DD iotort.c' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - -/* iotort.c 10/11/93 */ -/* test of I/O functions */ - - -static char rcsid[] = "$Id: $"; - -#include "sparse.h" -#include "zmatrix.h" - - -#define errmesg(mesg) printf("Error: %s error: line %d\n",mesg,__LINE__) -#define notice(mesg) printf("# Testing %s...\n",mesg); - - -void main() -{ - VEC *x; - MAT *A; - PERM *pivot; - IVEC *ix; - SPMAT *spA; - ZVEC *zx; - ZMAT *ZA; - char yes; - int i; - FILE *fp; - - mem_info_on(TRUE); - - if ((fp = fopen("iotort.dat","w")) == NULL) { - printf(" !!! Cannot open file %s for writing\n\n","iotort.dat"); - exit(1); - } - - x = v_get(10); - A = m_get(3,3); - zx = zv_get(10); - ZA = zm_get(3,3); - pivot = px_get(10); - ix = iv_get(10); - spA = sp_get(3,3,2); - - v_rand(x); - m_rand(A); - zv_rand(zx); - zm_rand(ZA); - px_ident(pivot); - for (i=0; i < 10; i++) - ix->ive[i] = i+1; - for (i=0; i < spA->m; i++) { - sp_set_val(spA,i,i,1.0); - if (i > 0) sp_set_val(spA,i-1,i,-1.0); - } - - notice(" VEC output"); - v_foutput(fp,x); - notice(" MAT output"); - m_foutput(fp,A); - notice(" ZVEC output"); - zv_foutput(fp,zx); - notice(" ZMAT output"); - zm_foutput(fp,ZA); - notice(" PERM output"); - px_foutput(fp,pivot); - notice(" IVEC output"); - iv_foutput(fp,ix); - notice(" SPMAT output"); - sp_foutput(fp,spA); - fprintf(fp,"Y"); - fclose(fp); - - printf("\nENTER SOME VALUES:\n\n"); - - if ((fp = fopen("iotort.dat","r")) == NULL) { - printf(" !!! Cannot open file %s for reading\n\n","iotort.dat"); - exit(1); - } - - notice(" VEC input/output"); - x = v_finput(fp,x); - v_output(x); - - notice(" MAT input/output"); - A = m_finput(fp,A); - m_output(A); - - notice(" ZVEC input/output"); - zx = zv_finput(fp,zx); - zv_output(zx); - - notice(" ZMAT input/output"); - ZA = zm_finput(fp,ZA); - zm_output(ZA); - - notice(" PERM input/output"); - pivot = px_finput(fp,pivot); - px_output(pivot); - - notice(" IVEC input/output"); - ix = iv_finput(fp,ix); - iv_output(ix); - - notice(" SPMAT input/output"); - SP_FREE(spA); - spA = sp_finput(fp); - sp_output(spA); - - notice(" general input"); - finput(fp," finish the test? ","%c",&yes); - if (yes == 'y' || yes == 'Y' ) - printf(" YES\n"); - else printf(" NO\n"); - fclose(fp); - - mem_info(); -} //GO.SYSIN DD iotort.c echo err.h 1>&2 sed >err.h <<'//GO.SYSIN DD err.h' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -/* err.h 28/09/1993 */ - -/* RCS id: $Id: err.h,v 1.1 1994/01/13 05:38:03 des Exp $ */ - - -#ifndef ERRHEADER -#define ERRHEADER - - -#include <setjmp.h> -#include "machine.h" - -/* Error recovery */ - -extern jmp_buf restart; - - -/* max. # of error lists */ -#define ERR_LIST_MAX_LEN 10 - -/* main error functions */ -#ifndef ANSI_C -extern int ev_err(); /* main error handler */ -extern int set_err_flag(); /* for different ways of handling - errors, returns old value */ -extern int count_errs(); /* to avoid "too many errors" */ -extern int err_list_attach(); /* for attaching a list of errors */ -extern int err_is_list_attached(); /* checking if a list is attached */ -extern int err_list_free(); /* freeing a list of errors */ - -#else /* ANSI_C */ - -extern int ev_err(char *,int,int,char *,int); /* main error handler */ -extern int set_err_flag(int flag); /* for different ways of handling - errors, returns old value */ -extern int count_errs(int true_false); /* to avoid "too many errors" */ -extern int err_list_attach(int list_num, int list_len, - char **err_ptr,int warn); /* for attaching a list of errors */ -extern int err_is_list_attached(int list_num); /* checking if a list - is attached */ -extern int err_list_free(int list_num); /* freeing a list of errors */ - -#endif - - -/* error(E_TYPE,"myfunc") raises error type E_TYPE for function my_func() */ -#define error(err_num,fn_name) ev_err(__FILE__,err_num,__LINE__,fn_name,0) - -/* warning(WARN_TYPE,"myfunc") raises warning type WARN_TYPE for - function my_func() */ -#define warning(err_num,fn_name) ev_err(__FILE__,err_num,__LINE__,fn_name,1) - - -/* error flags */ -#define EF_EXIT 0 /* exit on error */ -#define EF_ABORT 1 /* abort (dump core) on error */ -#define EF_JUMP 2 /* jump on error */ -#define EF_SILENT 3 /* jump, but don't print message */ -#define ERREXIT() set_err_flag(EF_EXIT) -#define ERRABORT() set_err_flag(EF_ABORT) -/* don't print message */ -#define SILENTERR() if ( ! setjmp(restart) ) set_err_flag(EF_SILENT) -/* return here on error */ -#define ON_ERROR() if ( ! setjmp(restart) ) set_err_flag(EF_JUMP) - - -/* error types */ -#define E_UNKNOWN 0 -#define E_SIZES 1 -#define E_BOUNDS 2 -#define E_MEM 3 -#define E_SING 4 -#define E_POSDEF 5 -#define E_FORMAT 6 -#define E_INPUT 7 -#define E_NULL 8 -#define E_SQUARE 9 -#define E_RANGE 10 -#define E_INSITU2 11 -#define E_INSITU 12 -#define E_ITER 13 -#define E_CONV 14 -#define E_START 15 -#define E_SIGNAL 16 -#define E_INTERN 17 -#define E_EOF 18 -#define E_SHARED_VECS 19 -#define E_NEG 20 -#define E_OVERWRITE 21 - -/* warning types */ -#define WARN_UNKNOWN 0 -#define WARN_WRONG_TYPE 1 -#define WARN_NO_MARK 2 -#define WARN_RES_LESS_0 3 -#define WARN_SHARED_VEC 4 - - -/* error catching macros */ - -/* execute err_part if error errnum is raised while executing ok_part */ -#define catch(errnum,ok_part,err_part) \ - { jmp_buf _save; int _err_num, _old_flag; \ - _old_flag = set_err_flag(EF_SILENT); \ - MEM_COPY(restart,_save,sizeof(jmp_buf)); \ - if ( (_err_num=setjmp(restart)) == 0 ) \ - { ok_part; \ - set_err_flag(_old_flag); \ - MEM_COPY(_save,restart,sizeof(jmp_buf)); } \ - else if ( _err_num == errnum ) \ - { set_err_flag(_old_flag); \ - MEM_COPY(_save,restart,sizeof(jmp_buf)); \ - err_part; } \ - else { set_err_flag(_old_flag); \ - MEM_COPY(_save,restart,sizeof(jmp_buf)); \ - error(_err_num,"catch"); \ - } \ - } - - -/* execute err_part if any error raised while executing ok_part */ -#define catchall(ok_part,err_part) \ - { jmp_buf _save; int _err_num, _old_flag; \ - _old_flag = set_err_flag(EF_SILENT); \ - MEM_COPY(restart,_save,sizeof(jmp_buf)); \ - if ( (_err_num=setjmp(restart)) == 0 ) \ - { ok_part; \ - set_err_flag(_old_flag); \ - MEM_COPY(_save,restart,sizeof(jmp_buf)); } \ - else \ - { set_err_flag(_old_flag); \ - MEM_COPY(_save,restart,sizeof(jmp_buf)); \ - err_part; } \ - } - - -/* print message if error raised while executing ok_part, - then re-raise error to trace calls */ -#define tracecatch(ok_part,function) \ - { jmp_buf _save; int _err_num, _old_flag; \ - _old_flag = set_err_flag(EF_JUMP); \ - MEM_COPY(restart,_save,sizeof(jmp_buf)); \ - if ( (_err_num=setjmp(restart)) == 0 ) \ - { ok_part; \ - set_err_flag(_old_flag); \ - MEM_COPY(_save,restart,sizeof(jmp_buf)); } \ - else \ - { set_err_flag(_old_flag); \ - MEM_COPY(_save,restart,sizeof(jmp_buf)); \ - error(_err_num,function); } \ - } - - - -#endif /* ERRHEADER */ //GO.SYSIN DD err.h echo meminfo.h 1>&2 sed >meminfo.h <<'//GO.SYSIN DD meminfo.h' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -/* meminfo.h 26/08/93 */ -/* changed 11/12/93 */ - - -#ifndef MEM_INFOH -#define MEM_INFOH - - - -/* for hash table in mem_stat.c */ -/* Note: the hash size should be a prime, or at very least odd */ -#define MEM_HASHSIZE 509 -#define MEM_HASHSIZE_FILE "meminfo.h" - - -/* default: memory information is off */ -/* set it to 1 if you want it all the time */ -#define MEM_SWITCH_ON_DEF 0 - - -/* available standard types */ -#define TYPE_NULL (-1) -#define TYPE_MAT 0 -#define TYPE_BAND 1 -#define TYPE_PERM 2 -#define TYPE_VEC 3 -#define TYPE_IVEC 4 - -#ifdef SPARSE -#define TYPE_ITER 5 -#define TYPE_SPROW 6 -#define TYPE_SPMAT 7 -#endif - -#ifdef COMPLEX -#ifdef SPARSE -#define TYPE_ZVEC 8 -#define TYPE_ZMAT 9 -#else -#define TYPE_ZVEC 5 -#define TYPE_ZMAT 6 -#endif -#endif - -/* structure for memory information */ -typedef struct { - long bytes; /* # of allocated bytes for each type (summary) */ - int numvar; /* # of allocated variables for each type */ -} MEM_ARRAY; - - - -#ifdef ANSI_C - -int mem_info_is_on(void); -int mem_info_on(int sw); - -long mem_info_bytes(int type,int list); -int mem_info_numvar(int type,int list); -void mem_info_file(FILE * fp,int list); - -void mem_bytes_list(int type,int old_size,int new_size, - int list); -void mem_numvar_list(int type, int num, int list); - -int mem_stat_reg_list(void **var,int type,int list); -int mem_stat_mark(int mark); -int mem_stat_free_list(int mark,int list); -int mem_stat_show_mark(void); -void mem_stat_dump(FILE *fp,int list); -int mem_attach_list(int list,int ntypes,char *type_names[], - int (*free_funcs[])(), MEM_ARRAY info_sum[]); -int mem_free_vars(int list); -int mem_is_list_attached(int list); -void mem_dump_list(FILE *fp,int list); -int mem_stat_reg_vars(int list,int type,...); - -#else -int mem_info_is_on(); -int mem_info_on(); - -long mem_info_bytes(); -int mem_info_numvar(); -void mem_info_file(); - -void mem_bytes_list(); -void mem_numvar_list(); - -int mem_stat_reg_list(); -int mem_stat_mark(); -int mem_stat_free_list(); -int mem_stat_show_mark(); -void mem_stat_dump(); -int mem_attach_list(); -int mem_free_vars(); -int mem_is_list_attached(); -void mem_dump_list(); -int mem_stat_reg_vars(); - -#endif - -/* macros */ - -#define mem_info() mem_info_file(stdout,0) - -#define mem_stat_reg(var,type) mem_stat_reg_list((void **)var,type,0) -#define MEM_STAT_REG(var,type) mem_stat_reg_list((void **)&(var),type,0) -#define mem_stat_free(mark) mem_stat_free_list(mark,0) - -#define mem_bytes(type,old_size,new_size) \ - mem_bytes_list(type,old_size,new_size,0) - -#define mem_numvar(type,num) mem_numvar_list(type,num,0) - - -/* internal type */ - -typedef struct { - char **type_names; /* array of names of types (strings) */ - int (**free_funcs)(); /* array of functions for releasing types */ - unsigned ntypes; /* max number of types */ - MEM_ARRAY *info_sum; /* local array for keeping track of memory */ -} MEM_CONNECT; - -/* max number of lists of types */ -#define MEM_CONNECT_MAX_LISTS 5 - - -#endif //GO.SYSIN DD meminfo.h echo machine.h 1>&2 sed >machine.h <<'//GO.SYSIN DD machine.h' 's/^-//' -/* machine.h. Generated automatically by configure. */ -/* Any machine specific stuff goes here */ -/* Add details necessary for your own installation here! */ - -/* RCS id: $Id: $ */ - -/* This is for use with "configure" -- if you are not using configure - then use machine.van for the "vanilla" version of machine.h */ - -/* Note special macros: ANSI_C (ANSI C syntax) - SEGMENTED (segmented memory machine e.g. MS-DOS) - MALLOCDECL (declared if malloc() etc have - been declared) */ - -#define const - -/* #undef MALLOCDECL */ -#define NOT_SEGMENTED 1 -#define HAVE_MEMORY_H 1 -/* #undef HAVE_COMPLEX_H */ -#define HAVE_MALLOC_H 1 -#define STDC_HEADERS 1 -#define HAVE_BCOPY 1 -#define HAVE_BZERO 1 -#define CHAR0ISDBL0 1 -#define WORDS_BIGENDIAN 1 -#define U_INT_DEF 1 -#define VARARGS 1 -#define HAVE_PROTOTYPES 1 -/* #undef HAVE_PROTOTYPES_IN_STRUCT */ - -/* for inclusion into C++ files */ -#ifdef __cplusplus -#define ANSI_C 1 -#ifndef HAVE_PROTOTYPES -#define HAVE_PROTOTYPES 1 -#endif -#ifndef HAVE_PROTOTYPES_IN_STRUCT -#define HAVE_PROTOTYPES_IN_STRUCT 1 -#endif -#endif /* __cplusplus */ - -/* example usage: VEC *PROTO(v_get,(int dim)); */ -#ifdef HAVE_PROTOTYPES -#define PROTO(name,args) name args -#else -#define PROTO(name,args) name() -#endif /* HAVE_PROTOTYPES */ -#ifdef HAVE_PROTOTYPES_IN_STRUCT -/* PROTO_() is to be used instead of PROTO() in struct's and typedef's */ -#define PROTO_(name,args) name args -#else -#define PROTO_(name,args) name() -#endif /* HAVE_PROTOTYPES_IN_STRUCT */ - -/* for basic or larger versions */ -#define COMPLEX 1 -#define SPARSE 1 - -/* for loop unrolling */ -/* #undef VUNROLL */ -/* #undef MUNROLL */ - -/* for segmented memory */ -#ifndef NOT_SEGMENTED -#define SEGMENTED -#endif - -/* if the system has malloc.h */ -#ifdef HAVE_MALLOC_H -#define MALLOCDECL 1 -#include <malloc.h> -#endif - -/* any compiler should have this header */ -/* if not, change it */ -#include <stdio.h> - - -/* Check for ANSI C memmove and memset */ -#ifdef STDC_HEADERS - -/* standard copy & zero functions */ -#define MEM_COPY(from,to,size) memmove((to),(from),(size)) -#define MEM_ZERO(where,size) memset((where),'\0',(size)) - -#ifndef ANSI_C -#define ANSI_C 1 -#endif - -#endif - -/* standard headers */ -#ifdef ANSI_C -#include <stdlib.h> -#include <stddef.h> -#include <string.h> -#include <float.h> -#endif - - -/* if have bcopy & bzero and no alternatives yet known, use them */ -#ifdef HAVE_BCOPY -#ifndef MEM_COPY -/* nonstandard copy function */ -#define MEM_COPY(from,to,size) bcopy((char *)(from),(char *)(to),(int)(size)) -#endif -#endif - -#ifdef HAVE_BZERO -#ifndef MEM_ZERO -/* nonstandard zero function */ -#define MEM_ZERO(where,size) bzero((char *)(where),(int)(size)) -#endif -#endif - -/* if the system has complex.h */ -#ifdef HAVE_COMPLEX_H -#include <complex.h> -#endif - -/* If prototypes are available & ANSI_C not yet defined, then define it, - but don't include any header files as the proper ANSI C headers - aren't here */ -#ifdef HAVE_PROTOTYPES -#ifndef ANSI_C -#define ANSI_C 1 -#endif -#endif - -/* floating point precision */ - -/* you can choose single, double or long double (if available) precision */ - -#define FLOAT 1 -#define DOUBLE 2 -#define LONG_DOUBLE 3 - -/* #undef REAL_FLT */ -/* #undef REAL_DBL */ - -/* if nothing is defined, choose double precision */ -#ifndef REAL_DBL -#ifndef REAL_FLT -#define REAL_DBL 1 -#endif -#endif - -/* single precision */ -#ifdef REAL_FLT -#define Real float -#define LongReal float -#define REAL FLOAT -#define LONGREAL FLOAT -#endif - -/* double precision */ -#ifdef REAL_DBL -#define Real double -#define LongReal double -#define REAL DOUBLE -#define LONGREAL DOUBLE -#endif - - -/* machine epsilon or unit roundoff error */ -/* This is correct on most IEEE Real precision systems */ -#ifdef DBL_EPSILON -#if REAL == DOUBLE -#define MACHEPS DBL_EPSILON -#elif REAL == FLOAT -#define MACHEPS FLT_EPSILON -#elif REAL == LONGDOUBLE -#define MACHEPS LDBL_EPSILON -#endif -#endif - -#define F_MACHEPS 1.19209e-07 -#define D_MACHEPS 2.22045e-16 - -#ifndef MACHEPS -#if REAL == DOUBLE -#define MACHEPS D_MACHEPS -#elif REAL == FLOAT -#define MACHEPS F_MACHEPS -#elif REAL == LONGDOUBLE -#define MACHEPS D_MACHEPS -#endif -#endif - -/* #undef M_MACHEPS */ - -/******************** -#ifdef DBL_EPSILON -#define MACHEPS DBL_EPSILON -#endif -#ifdef M_MACHEPS -#ifndef MACHEPS -#define MACHEPS M_MACHEPS -#endif -#endif -********************/ - -#define M_MAX_INT 2147483647 -#ifdef M_MAX_INT -#ifndef MAX_RAND -#define MAX_RAND ((double)(M_MAX_INT)) -#endif -#endif - -/* for non-ANSI systems */ -#ifndef HUGE_VAL -#define HUGE_VAL HUGE -#endif - - -#ifdef ANSI_C -extern int isatty(int); -#endif - //GO.SYSIN DD machine.h echo matrix.h 1>&2 sed >matrix.h <<'//GO.SYSIN DD matrix.h' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -/* - Type definitions for general purpose maths package -*/ - -#ifndef MATRIXH - -/* RCS id: $Id: matrix.h,v 1.18 1994/04/16 00:33:37 des Exp $ */ - -#define MATRIXH - -#include "machine.h" -#include "err.h" -#include "meminfo.h" - -/* unsigned integer type */ -#ifndef U_INT_DEF -typedef unsigned int u_int; -#define U_INT_DEF -#endif - -/* vector definition */ -typedef struct { - u_int dim, max_dim; - Real *ve; - } VEC; - -/* matrix definition */ -typedef struct { - u_int m, n; - u_int max_m, max_n, max_size; - Real **me,*base; /* base is base of alloc'd mem */ - } MAT; - -/* band matrix definition */ -typedef struct { - MAT *mat; /* matrix */ - int lb,ub; /* lower and upper bandwidth */ - } BAND; - - -/* permutation definition */ -typedef struct { - u_int size, max_size, *pe; - } PERM; - -/* integer vector definition */ -typedef struct { - u_int dim, max_dim; - int *ive; - } IVEC; - - -#ifndef MALLOCDECL -#ifndef ANSI_C -extern char *malloc(), *calloc(), *realloc(); -#else -extern void *malloc(size_t), - *calloc(size_t,size_t), - *realloc(void *,size_t); -#endif -#endif - -#ifndef ANSI_C -extern void m_version(); -#else -void m_version( void ); -#endif - -#ifndef ANSI_C -/* allocate one object of given type */ -#define NEW(type) ((type *)calloc(1,sizeof(type))) - -/* allocate num objects of given type */ -#define NEW_A(num,type) ((type *)calloc((unsigned)(num),sizeof(type))) - - /* re-allocate arry to have num objects of the given type */ -#define RENEW(var,num,type) \ - ((var)=(type *)((var) ? \ - realloc((char *)(var),(unsigned)(num)*sizeof(type)) : \ - calloc((unsigned)(num),sizeof(type)))) - -#define MEMCOPY(from,to,n_items,type) \ - MEM_COPY((char *)(from),(char *)(to),(unsigned)(n_items)*sizeof(type)) - -#else -/* allocate one object of given type */ -#define NEW(type) ((type *)calloc((size_t)1,(size_t)sizeof(type))) - -/* allocate num objects of given type */ -#define NEW_A(num,type) ((type *)calloc((size_t)(num),(size_t)sizeof(type))) - - /* re-allocate arry to have num objects of the given type */ -#define RENEW(var,num,type) \ - ((var)=(type *)((var) ? \ - realloc((char *)(var),(size_t)((num)*sizeof(type))) : \ - calloc((size_t)(num),(size_t)sizeof(type)))) - -#define MEMCOPY(from,to,n_items,type) \ - MEM_COPY((char *)(from),(char *)(to),(unsigned)(n_items)*sizeof(type)) - -#endif - -/* type independent min and max operations */ -#ifndef max -#define max(a,b) ((a) > (b) ? (a) : (b)) -#endif -#ifndef min -#define min(a,b) ((a) > (b) ? (b) : (a)) -#endif - - -#undef TRUE -#define TRUE 1 -#undef FALSE -#define FALSE 0 - - -/* for input routines */ -#define MAXLINE 81 - - -/* Dynamic memory allocation */ - -/* Should use M_FREE/V_FREE/PX_FREE in programs instead of m/v/px_free() - as this is considerably safer -- also provides a simple type check ! */ - -#ifndef ANSI_C - -extern VEC *v_get(), *v_resize(); -extern MAT *m_get(), *m_resize(); -extern PERM *px_get(), *px_resize(); -extern IVEC *iv_get(), *iv_resize(); -extern int m_free(),v_free(); -extern int px_free(); -extern int iv_free(); -extern BAND *bd_get(), *bd_resize(); -extern int bd_free(); - -#else - -/* get/resize vector to given dimension */ -extern VEC *v_get(int), *v_resize(VEC *,int); -/* get/resize matrix to be m x n */ -extern MAT *m_get(int,int), *m_resize(MAT *,int,int); -/* get/resize permutation to have the given size */ -extern PERM *px_get(int), *px_resize(PERM *,int); -/* get/resize an integer vector to given dimension */ -extern IVEC *iv_get(int), *iv_resize(IVEC *,int); -/* get/resize a band matrix to given dimension */ -extern BAND *bd_get(int,int,int), *bd_resize(BAND *,int,int,int); - -/* free (de-allocate) (band) matrices, vectors, permutations and - integer vectors */ -extern int iv_free(IVEC *); -extern m_free(MAT *),v_free(VEC *),px_free(PERM *); -extern int bd_free(BAND *); - -#endif - - -/* MACROS */ - -/* macros that also check types and sets pointers to NULL */ -#define M_FREE(mat) ( m_free(mat), (mat)=(MAT *)NULL ) -#define V_FREE(vec) ( v_free(vec), (vec)=(VEC *)NULL ) -#define PX_FREE(px) ( px_free(px), (px)=(PERM *)NULL ) -#define IV_FREE(iv) ( iv_free(iv), (iv)=(IVEC *)NULL ) - -#define MAXDIM 2001 - - -/* Entry level access to data structures */ -#ifdef DEBUG - -/* returns x[i] */ -#define v_entry(x,i) (((i) < 0 || (i) >= (x)->dim) ? \ - error(E_BOUNDS,"v_entry"), 0.0 : (x)->ve[i] ) - -/* x[i] <- val */ -#define v_set_val(x,i,val) ((x)->ve[i] = ((i) < 0 || (i) >= (x)->dim) ? \ - error(E_BOUNDS,"v_set_val"), 0.0 : (val)) - -/* x[i] <- x[i] + val */ -#define v_add_val(x,i,val) ((x)->ve[i] += ((i) < 0 || (i) >= (x)->dim) ? \ - error(E_BOUNDS,"v_add_val"), 0.0 : (val)) - -/* x[i] <- x[i] - val */ -#define v_sub_val(x,i,val) ((x)->ve[i] -= ((i) < 0 || (i) >= (x)->dim) ? \ - error(E_BOUNDS,"v_sub_val"), 0.0 : (val)) - -/* returns A[i][j] */ -#define m_entry(A,i,j) (((i) < 0 || (i) >= (A)->m || \ - (j) < 0 || (j) >= (A)->n) ? \ - error(E_BOUNDS,"m_entry"), 0.0 : (A)->me[i][j] ) - -/* A[i][j] <- val */ -#define m_set_val(A,i,j,val) ((A)->me[i][j] = ((i) < 0 || (i) >= (A)->m || \ - (j) < 0 || (j) >= (A)->n) ? \ - error(E_BOUNDS,"m_set_val"), 0.0 : (val) ) - -/* A[i][j] <- A[i][j] + val */ -#define m_add_val(A,i,j,val) ((A)->me[i][j] += ((i) < 0 || (i) >= (A)->m || \ - (j) < 0 || (j) >= (A)->n) ? \ - error(E_BOUNDS,"m_add_val"), 0.0 : (val) ) - -/* A[i][j] <- A[i][j] - val */ -#define m_sub_val(A,i,j,val) ((A)->me[i][j] -= ((i) < 0 || (i) >= (A)->m || \ - (j) < 0 || (j) >= (A)->n) ? \ - error(E_BOUNDS,"m_sub_val"), 0.0 : (val) ) -#else - -/* returns x[i] */ -#define v_entry(x,i) ((x)->ve[i]) - -/* x[i] <- val */ -#define v_set_val(x,i,val) ((x)->ve[i] = (val)) - -/* x[i] <- x[i] + val */ -#define v_add_val(x,i,val) ((x)->ve[i] += (val)) - - /* x[i] <- x[i] - val */ -#define v_sub_val(x,i,val) ((x)->ve[i] -= (val)) - -/* returns A[i][j] */ -#define m_entry(A,i,j) ((A)->me[i][j]) - -/* A[i][j] <- val */ -#define m_set_val(A,i,j,val) ((A)->me[i][j] = (val) ) - -/* A[i][j] <- A[i][j] + val */ -#define m_add_val(A,i,j,val) ((A)->me[i][j] += (val) ) - -/* A[i][j] <- A[i][j] - val */ -#define m_sub_val(A,i,j,val) ((A)->me[i][j] -= (val) ) - -#endif - - -/* I/O routines */ -#ifndef ANSI_C - -extern void v_foutput(),m_foutput(),px_foutput(); -extern void iv_foutput(); -extern VEC *v_finput(); -extern MAT *m_finput(); -extern PERM *px_finput(); -extern IVEC *iv_finput(); -extern int fy_or_n(), fin_int(), yn_dflt(), skipjunk(); -extern double fin_double(); - -#else - -/* print x on file fp */ -void v_foutput(FILE *fp,VEC *x), - /* print A on file fp */ - m_foutput(FILE *fp,MAT *A), - /* print px on file fp */ - px_foutput(FILE *fp,PERM *px); -/* print ix on file fp */ -void iv_foutput(FILE *fp,IVEC *ix); - -/* Note: if out is NULL, then returned object is newly allocated; - Also: if out is not NULL, then that size is assumed */ - -/* read in vector from fp */ -VEC *v_finput(FILE *fp,VEC *out); -/* read in matrix from fp */ -MAT *m_finput(FILE *fp,MAT *out); -/* read in permutation from fp */ -PERM *px_finput(FILE *fp,PERM *out); -/* read in int vector from fp */ -IVEC *iv_finput(FILE *fp,IVEC *out); - -/* fy_or_n -- yes-or-no to question in string s - -- question written to stderr, input from fp - -- if fp is NOT a tty then return y_n_dflt */ -int fy_or_n(FILE *fp,char *s); - -/* yn_dflt -- sets the value of y_n_dflt to val */ -int yn_dflt(int val); - -/* fin_int -- return integer read from file/stream fp - -- prompt s on stderr if fp is a tty - -- check that x lies between low and high: re-prompt if - fp is a tty, error exit otherwise - -- ignore check if low > high */ -int fin_int(FILE *fp,char *s,int low,int high); - -/* fin_double -- return double read from file/stream fp - -- prompt s on stderr if fp is a tty - -- check that x lies between low and high: re-prompt if - fp is a tty, error exit otherwise - -- ignore check if low > high */ -double fin_double(FILE *fp,char *s,double low,double high); - -/* it skips white spaces and strings of the form #....\n - Here .... is a comment string */ -int skipjunk(FILE *fp); - -#endif - - -/* MACROS */ - -/* macros to use stdout and stdin instead of explicit fp */ -#define v_output(vec) v_foutput(stdout,vec) -#define v_input(vec) v_finput(stdin,vec) -#define m_output(mat) m_foutput(stdout,mat) -#define m_input(mat) m_finput(stdin,mat) -#define px_output(px) px_foutput(stdout,px) -#define px_input(px) px_finput(stdin,px) -#define iv_output(iv) iv_foutput(stdout,iv) -#define iv_input(iv) iv_finput(stdin,iv) - -/* general purpose input routine; skips comments # ... \n */ -#define finput(fp,prompt,fmt,var) \ - ( ( isatty(fileno(fp)) ? fprintf(stderr,prompt) : skipjunk(fp) ), \ - fscanf(fp,fmt,var) ) -#define input(prompt,fmt,var) finput(stdin,prompt,fmt,var) -#define fprompter(fp,prompt) \ - ( isatty(fileno(fp)) ? fprintf(stderr,prompt) : skipjunk(fp) ) -#define prompter(prompt) fprompter(stdin,prompt) -#define y_or_n(s) fy_or_n(stdin,s) -#define in_int(s,lo,hi) fin_int(stdin,s,lo,hi) -#define in_double(s,lo,hi) fin_double(stdin,s,lo,hi) - -/* Copying routines */ -#ifndef ANSI_C -extern MAT *_m_copy(), *m_move(), *vm_move(); -extern VEC *_v_copy(), *v_move(), *mv_move(); -extern PERM *px_copy(); -extern IVEC *iv_copy(), *iv_move(); -extern BAND *bd_copy(); - -#else - -/* copy in to out starting at out[i0][j0] */ -extern MAT *_m_copy(MAT *in,MAT *out,u_int i0,u_int j0), - * m_move(MAT *in, int, int, int, int, MAT *out, int, int), - *vm_move(VEC *in, int, MAT *out, int, int, int, int); -/* copy in to out starting at out[i0] */ -extern VEC *_v_copy(VEC *in,VEC *out,u_int i0), - * v_move(VEC *in, int, int, VEC *out, int), - *mv_move(MAT *in, int, int, int, int, VEC *out, int); -extern PERM *px_copy(PERM *in,PERM *out); -extern IVEC *iv_copy(IVEC *in,IVEC *out), - *iv_move(IVEC *in, int, int, IVEC *out, int); -extern BAND *bd_copy(BAND *in,BAND *out); - -#endif - - -/* MACROS */ -#define m_copy(in,out) _m_copy(in,out,0,0) -#define v_copy(in,out) _v_copy(in,out,0) - - -/* Initialisation routines -- to be zero, ones, random or identity */ -#ifndef ANSI_C -extern VEC *v_zero(), *v_rand(), *v_ones(); -extern MAT *m_zero(), *m_ident(), *m_rand(), *m_ones(); -extern PERM *px_ident(); -extern IVEC *iv_zero(); -#else -extern VEC *v_zero(VEC *), *v_rand(VEC *), *v_ones(VEC *); -extern MAT *m_zero(MAT *), *m_ident(MAT *), *m_rand(MAT *), - *m_ones(MAT *); -extern PERM *px_ident(PERM *); -extern IVEC *iv_zero(IVEC *); -#endif - -/* Basic vector operations */ -#ifndef ANSI_C -extern VEC *sv_mlt(), *mv_mlt(), *vm_mlt(), *v_add(), *v_sub(), - *px_vec(), *pxinv_vec(), *v_mltadd(), *v_map(), *_v_map(), - *v_lincomb(), *v_linlist(); -extern double v_min(), v_max(), v_sum(); -extern VEC *v_star(), *v_slash(), *v_sort(); -extern double _in_prod(), __ip__(); -extern void __mltadd__(), __add__(), __sub__(), - __smlt__(), __zero__(); -#else - -extern VEC *sv_mlt(double,VEC *,VEC *), /* out <- s.x */ - *mv_mlt(MAT *,VEC *,VEC *), /* out <- A.x */ - *vm_mlt(MAT *,VEC *,VEC *), /* out^T <- x^T.A */ - *v_add(VEC *,VEC *,VEC *), /* out <- x + y */ - *v_sub(VEC *,VEC *,VEC *), /* out <- x - y */ - *px_vec(PERM *,VEC *,VEC *), /* out <- P.x */ - *pxinv_vec(PERM *,VEC *,VEC *), /* out <- P^{-1}.x */ - *v_mltadd(VEC *,VEC *,double,VEC *), /* out <- x + s.y */ -#ifdef PROTOTYPES_IN_STRUCT - *v_map(double (*f)(double),VEC *,VEC *), - /* out[i] <- f(x[i]) */ - *_v_map(double (*f)(void *,double),void *,VEC *,VEC *), -#else - *v_map(double (*f)(),VEC *,VEC *), /* out[i] <- f(x[i]) */ - *_v_map(double (*f)(),void *,VEC *,VEC *), -#endif - *v_lincomb(int,VEC **,Real *,VEC *), - /* out <- sum_i s[i].x[i] */ - *v_linlist(VEC *out,VEC *v1,double a1,...); - /* out <- s1.x1 + s2.x2 + ... */ - -/* returns min_j x[j] (== x[i]) */ -extern double v_min(VEC *, int *), - /* returns max_j x[j] (== x[i]) */ - v_max(VEC *, int *), - /* returns sum_i x[i] */ - v_sum(VEC *); - -/* Hadamard product: out[i] <- x[i].y[i] */ -extern VEC *v_star(VEC *, VEC *, VEC *), - /* out[i] <- x[i] / y[i] */ - *v_slash(VEC *, VEC *, VEC *), - /* sorts x, and sets order so that sorted x[i] = x[order[i]] */ - *v_sort(VEC *, PERM *); - -/* returns inner product starting at component i0 */ -extern double _in_prod(VEC *x,VEC *y,u_int i0), - /* returns sum_{i=0}^{len-1} x[i].y[i] */ - __ip__(Real *,Real *,int); - -/* see v_mltadd(), v_add(), v_sub() and v_zero() */ -extern void __mltadd__(Real *,Real *,double,int), - __add__(Real *,Real *,Real *,int), - __sub__(Real *,Real *,Real *,int), - __smlt__(Real *,double,Real *,int), - __zero__(Real *,int); - -#endif - - -/* MACRO */ -/* usual way of computing the inner product */ -#define in_prod(a,b) _in_prod(a,b,0) - -/* Norms */ -/* scaled vector norms -- scale == NULL implies unscaled */ -#ifndef ANSI_C - -extern double _v_norm1(), _v_norm2(), _v_norm_inf(), - m_norm1(), m_norm_inf(), m_norm_frob(); - -#else - /* returns sum_i |x[i]/scale[i]| */ -extern double _v_norm1(VEC *x,VEC *scale), - /* returns (scaled) Euclidean norm */ - _v_norm2(VEC *x,VEC *scale), - /* returns max_i |x[i]/scale[i]| */ - _v_norm_inf(VEC *x,VEC *scale); - -/* unscaled matrix norms */ -extern double m_norm1(MAT *A), m_norm_inf(MAT *A), m_norm_frob(MAT *A); - -#endif - - -/* MACROS */ -/* unscaled vector norms */ -#define v_norm1(x) _v_norm1(x,VNULL) -#define v_norm2(x) _v_norm2(x,VNULL) -#define v_norm_inf(x) _v_norm_inf(x,VNULL) - -/* Basic matrix operations */ -#ifndef ANSI_C - -extern MAT *sm_mlt(), *m_mlt(), *mmtr_mlt(), *mtrm_mlt(), *m_add(), *m_sub(), - *sub_mat(), *m_transp(), *ms_mltadd(); - -extern BAND *bd_transp(); -extern MAT *px_rows(), *px_cols(), *swap_rows(), *swap_cols(), - *_set_row(), *_set_col(); -extern VEC *get_row(), *get_col(), *sub_vec(), - *mv_mltadd(), *vm_mltadd(); - -#else - -extern MAT *sm_mlt(double s,MAT *A,MAT *out), /* out <- s.A */ - *m_mlt(MAT *A,MAT *B,MAT *out), /* out <- A.B */ - *mmtr_mlt(MAT *A,MAT *B,MAT *out), /* out <- A.B^T */ - *mtrm_mlt(MAT *A,MAT *B,MAT *out), /* out <- A^T.B */ - *m_add(MAT *A,MAT *B,MAT *out), /* out <- A + B */ - *m_sub(MAT *A,MAT *B,MAT *out), /* out <- A - B */ - *sub_mat(MAT *A,u_int,u_int,u_int,u_int,MAT *out), - *m_transp(MAT *A,MAT *out), /* out <- A^T */ - /* out <- A + s.B */ - *ms_mltadd(MAT *A,MAT *B,double s,MAT *out); - - -extern BAND *bd_transp(BAND *in, BAND *out); /* out <- A^T */ -extern MAT *px_rows(PERM *px,MAT *A,MAT *out), /* out <- P.A */ - *px_cols(PERM *px,MAT *A,MAT *out), /* out <- A.P^T */ - *swap_rows(MAT *,int,int,int,int), - *swap_cols(MAT *,int,int,int,int), - /* A[i][j] <- out[j], j >= j0 */ - *_set_col(MAT *A,u_int i,VEC *out,u_int j0), - /* A[i][j] <- out[i], i >= i0 */ - *_set_row(MAT *A,u_int j,VEC *out,u_int i0); - -extern VEC *get_row(MAT *,u_int,VEC *), - *get_col(MAT *,u_int,VEC *), - *sub_vec(VEC *,int,int,VEC *), - /* out <- x + s.A.y */ - *mv_mltadd(VEC *x,VEC *y,MAT *A,double s,VEC *out), - /* out^T <- x^T + s.y^T.A */ - *vm_mltadd(VEC *x,VEC *y,MAT *A,double s,VEC *out); -#endif - - -/* MACROS */ -/* row i of A <- vec */ -#define set_row(mat,row,vec) _set_row(mat,row,vec,0) -/* col j of A <- vec */ -#define set_col(mat,col,vec) _set_col(mat,col,vec,0) - - -/* Basic permutation operations */ -#ifndef ANSI_C - -extern PERM *px_mlt(), *px_inv(), *px_transp(); -extern int px_sign(); - -#else - -extern PERM *px_mlt(PERM *px1,PERM *px2,PERM *out), /* out <- px1.px2 */ - *px_inv(PERM *px,PERM *out), /* out <- px^{-1} */ - /* swap px[i] and px[j] */ - *px_transp(PERM *px,u_int i,u_int j); - - /* returns sign(px) = +1 if px product of even # transpositions - -1 if ps product of odd # transpositions */ -extern int px_sign(PERM *); - -#endif - - -/* Basic integer vector operations */ -#ifndef ANSI_C - -extern IVEC *iv_add(), *iv_sub(), *iv_sort(); - -#else - -extern IVEC *iv_add(IVEC *ix,IVEC *iy,IVEC *out), /* out <- ix + iy */ - *iv_sub(IVEC *ix,IVEC *iy,IVEC *out), /* out <- ix - iy */ - /* sorts ix & sets order so that sorted ix[i] = old ix[order[i]] */ - *iv_sort(IVEC *ix, PERM *order); - -#endif - - -/* miscellaneous functions */ - -#ifndef ANSI_C - -extern double square(), cube(), mrand(); -extern void smrand(), mrandlist(); -extern void m_dump(), px_dump(), v_dump(), iv_dump(); -extern MAT *band2mat(); -extern BAND *mat2band(); - -#else - -double square(double x), /* returns x^2 */ - cube(double x), /* returns x^3 */ - mrand(void); /* returns random # in [0,1) */ - -void smrand(int seed), /* seeds mrand() */ - mrandlist(Real *x, int len); /* generates len random numbers */ - -void m_dump(FILE *fp,MAT *a), px_dump(FILE *,PERM *px), - v_dump(FILE *fp,VEC *x), iv_dump(FILE *fp, IVEC *ix); - -MAT *band2mat(BAND *bA, MAT *A); -BAND *mat2band(MAT *A, int lb,int ub, BAND *bA); - -#endif - - -/* miscellaneous constants */ -#define VNULL ((VEC *)NULL) -#define MNULL ((MAT *)NULL) -#define PNULL ((PERM *)NULL) -#define IVNULL ((IVEC *)NULL) -#define BDNULL ((BAND *)NULL) - - - -/* varying number of arguments */ - -#ifdef ANSI_C -#include <stdarg.h> - -/* prototypes */ - -int v_get_vars(int dim,...); -int iv_get_vars(int dim,...); -int m_get_vars(int m,int n,...); -int px_get_vars(int dim,...); - -int v_resize_vars(int new_dim,...); -int iv_resize_vars(int new_dim,...); -int m_resize_vars(int m,int n,...); -int px_resize_vars(int new_dim,...); - -int v_free_vars(VEC **,...); -int iv_free_vars(IVEC **,...); -int px_free_vars(PERM **,...); -int m_free_vars(MAT **,...); - -#elif VARARGS -/* old varargs is used */ - -#include <varargs.h> - -/* prototypes */ - -int v_get_vars(); -int iv_get_vars(); -int m_get_vars(); -int px_get_vars(); - -int v_resize_vars(); -int iv_resize_vars(); -int m_resize_vars(); -int px_resize_vars(); - -int v_free_vars(); -int iv_free_vars(); -int px_free_vars(); -int m_free_vars(); - -#endif - - -#endif - - //GO.SYSIN DD matrix.h echo iter.h 1>&2 sed >iter.h <<'//GO.SYSIN DD iter.h' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -/* iter.h 14/09/93 */ - -/* - - Structures for iterative methods - -*/ - -#ifndef ITERHH - -#define ITERHH - -/* RCS id: $Id: iter.h,v 1.2 1994/03/08 05:48:27 des Exp $ */ - - -#include "sparse.h" - - -/* basic structure for iterative methods */ - -/* type Fun_Ax for functions to get y = A*x */ -#ifdef ANSI_C -typedef VEC *(*Fun_Ax)(void *,VEC *,VEC *); -#else -typedef VEC *(*Fun_Ax)(); -#endif - - -/* type ITER */ -typedef struct Iter_data { - int shared_x; /* if TRUE then x is shared and it will not be free'd */ - int shared_b; /* if TRUE then b is shared and it will not be free'd */ - unsigned k; /* no. of direction (search) vectors; =0 - none */ - int limit; /* upper bound on the no. of iter. steps */ - int steps; /* no. of iter. steps done */ - Real eps; /* accuracy required */ - - VEC *x; /* input: initial guess; - output: approximate solution */ - VEC *b; /* right hand side of the equation A*x = b */ - - Fun_Ax Ax; /* function computing y = A*x */ - void *A_par; /* parameters for Ax */ - - Fun_Ax ATx; /* function computing y = A^T*x; - T = transpose */ - void *AT_par; /* parameters for ATx */ - - Fun_Ax Bx; /* function computing y = B*x; B - preconditioner */ - void *B_par; /* parameters for Bx */ - -#ifdef ANSI_C - -#ifdef PROTOTYPES_IN_STRUCT - void (*info)(struct Iter_data *, double, VEC *,VEC *); - /* function giving some information for a user; - nres - a norm of a residual res */ - - int (*stop_crit)(struct Iter_data *, double, VEC *,VEC *); - /* stopping criterion: - nres - a norm of res; - res - residual; - if returned value == TRUE then stop; - if returned value == FALSE then continue; */ -#else - void (*info)(); - int (*stop_crit)(); -#endif /* PROTOTYPES_IN_STRUCT */ - -#else - - void (*info)(); - /* function giving some information for a user */ - - int (*stop_crit)(); - /* stopping criterion: - if returned value == TRUE then stop; - if returned value == FALSE then continue; */ - -#endif /* ANSI_C */ - - Real init_res; /* the norm of the initial residual */ - -} ITER; - - -#define INULL (ITER *)NULL - -/* type Fun_info */ -#ifdef ANSI_C -typedef void (*Fun_info)(ITER *, double, VEC *,VEC *); -#else -typedef void (*Fun_info)(); -#endif - -/* type Fun_stp_crt */ -#ifdef ANSI_C -typedef int (*Fun_stp_crt)(ITER *, double, VEC *,VEC *); -#else -typedef int (*Fun_stp_crt)(); -#endif - - - -/* macros */ -/* default values */ - -#define ITER_LIMIT_DEF 1000 -#define ITER_EPS_DEF 1e-6 - -/* other macros */ - -/* set ip->Ax=fun and ip->A_par=fun_par */ -#define iter_Ax(ip,fun,fun_par) \ - (ip->Ax=(Fun_Ax)(fun),ip->A_par=(void *)(fun_par),0) -#define iter_ATx(ip,fun,fun_par) \ - (ip->ATx=(Fun_Ax)(fun),ip->AT_par=(void *)(fun_par),0) -#define iter_Bx(ip,fun,fun_par) \ - (ip->Bx=(Fun_Ax)(fun),ip->B_par=(void *)(fun_par),0) - -/* save free macro */ -#define ITER_FREE(ip) (iter_free(ip), (ip)=(ITER *)NULL) - - -/* prototypes from iter0.c */ - -#ifdef ANSI_C -/* standard information */ -void iter_std_info(ITER *ip,double nres,VEC *res,VEC *Bres); -/* standard stopping criterion */ -int iter_std_stop_crit(ITER *ip, double nres, VEC *res,VEC *Bres); - -/* get, resize and free ITER variable */ -ITER *iter_get(int lenb, int lenx); -ITER *iter_resize(ITER *ip,int lenb,int lenx); -int iter_free(ITER *ip); - -void iter_dump(FILE *fp,ITER *ip); - -/* copy ip1 to ip2 copying also elements of x and b */ -ITER *iter_copy(ITER *ip1, ITER *ip2); -/* copy ip1 to ip2 without copying elements of x and b */ -ITER *iter_copy2(ITER *ip1,ITER *ip2); - -/* functions for generating sparse matrices with random elements */ -SPMAT *iter_gen_sym(int n, int nrow); -SPMAT *iter_gen_nonsym(int m,int n,int nrow,double diag); -SPMAT *iter_gen_nonsym_posdef(int n,int nrow); - -#else - -void iter_std_info(); -int iter_std_stop_crit(); -ITER *iter_get(); -int iter_free(); -ITER *iter_resize(); -void iter_dump(); -ITER *iter_copy(); -ITER *iter_copy2(); -SPMAT *iter_gen_sym(); -SPMAT *iter_gen_nonsym(); -SPMAT *iter_gen_nonsym_posdef(); - -#endif - -/* prototypes from iter.c */ - -/* different iterative procedures */ -#ifdef ANSI_C -VEC *iter_cg(ITER *ip); -VEC *iter_cg1(ITER *ip); -VEC *iter_spcg(SPMAT *A,SPMAT *LLT,VEC *b,double eps,VEC *x,int limit, - int *steps); -VEC *iter_cgs(ITER *ip,VEC *r0); -VEC *iter_spcgs(SPMAT *A,SPMAT *B,VEC *b,VEC *r0,double eps,VEC *x, - int limit, int *steps); -VEC *iter_lsqr(ITER *ip); -VEC *iter_splsqr(SPMAT *A,VEC *b,double tol,VEC *x, - int limit,int *steps); -VEC *iter_gmres(ITER *ip); -VEC *iter_spgmres(SPMAT *A,SPMAT *B,VEC *b,double tol,VEC *x,int k, - int limit, int *steps); -MAT *iter_arnoldi_iref(ITER *ip,Real *h,MAT *Q,MAT *H); -MAT *iter_arnoldi(ITER *ip,Real *h,MAT *Q,MAT *H); -MAT *iter_sparnoldi(SPMAT *A,VEC *x0,int k,Real *h,MAT *Q,MAT *H); -VEC *iter_mgcr(ITER *ip); -VEC *iter_spmgcr(SPMAT *A,SPMAT *B,VEC *b,double tol,VEC *x,int k, - int limit, int *steps); -void iter_lanczos(ITER *ip,VEC *a,VEC *b,Real *beta2,MAT *Q); -void iter_splanczos(SPMAT *A,int m,VEC *x0,VEC *a,VEC *b,Real *beta2, - MAT *Q); -VEC *iter_lanczos2(ITER *ip,VEC *evals,VEC *err_est); -VEC *iter_splanczos2(SPMAT *A,int m,VEC *x0,VEC *evals,VEC *err_est); -VEC *iter_cgne(ITER *ip); -VEC *iter_spcgne(SPMAT *A,SPMAT *B,VEC *b,double eps,VEC *x, - int limit,int *steps); -#else -VEC *iter_cg(); -VEC *iter_cg1(); -VEC *iter_spcg(); -VEC *iter_cgs(); -VEC *iter_spcgs(); -VEC *iter_lsqr(); -VEC *iter_splsqr(); -VEC *iter_gmres(); -VEC *iter_spgmres(); -MAT *iter_arnoldi_iref(); -MAT *iter_arnoldi(); -MAT *iter_sparnoldi(); -VEC *iter_mgcr(); -VEC *iter_spmgcr(); -void iter_lanczos(); -void iter_splanczos(); -VEC *iter_lanczos2(); -VEC *iter_splanczos2(); -VEC *iter_cgne(); -VEC *iter_spcgne(); - -#endif - - -#endif /* ITERHH */ //GO.SYSIN DD iter.h echo matlab.h 1>&2 sed >matlab.h <<'//GO.SYSIN DD matlab.h' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -/* matlab.h -- Header file for matlab.c and spmatlab.c for save/load formats */ - -#ifndef MATLAB_DEF - -#define MATLAB_DEF - -/* structure required by MATLAB */ -typedef struct { - long type; /* matrix type */ - long m; /* # rows */ - long n; /* # cols */ - long imag; /* is complex? */ - long namlen; /* length of variable name */ - } matlab; - -/* macros for matrix storage type */ -#define INTEL 0 /* for 80x87 format */ -#define PC INTEL -#define MOTOROLA 1 /* 6888x format */ -#define SUN MOTOROLA -#define APOLLO MOTOROLA -#define MAC MOTOROLA -#define VAX_D 2 -#define VAX_G 3 - -#define COL_ORDER 0 -#define ROW_ORDER 1 - -#define DOUBLE_PREC 0 /* double precision */ -#define SINGLE_PREC 1 /* single precision */ -#define INT_32 2 /* 32 bit integers (signed) */ -#define INT_16 3 /* 16 bit integers (signed) */ -#define INT_16u 4 /* 16 bit integers (unsigned) */ -/* end of macros for matrix storage type */ - -#ifndef MACH_ID -#define MACH_ID MOTOROLA -#endif - -#define ORDER ROW_ORDER - -#if REAL == DOUBLE -#define PRECISION DOUBLE_PREC -#elif REAL == FLOAT -#define PRECISION SINGLE_PREC -#endif - - -/* prototypes */ - -#ifdef ANSI_C - -MAT *m_save(FILE *,MAT *,char *); -MAT *m_load(FILE *,char **); -VEC *v_save(FILE *,VEC *,char *); -double d_save(FILE *,double,char *); - -#else - -extern MAT *m_save(), *m_load(); -extern VEC *v_save(); -extern double d_save(); -#endif - -/* complex variant */ -#ifdef COMPLEX -#include "zmatrix.h" - -#ifdef ANSI_C -extern ZMAT *zm_save(FILE *fp,ZMAT *A,char *name); -extern ZVEC *zv_save(FILE *fp,ZVEC *x,char *name); -extern complex z_save(FILE *fp,complex z,char *name); -extern ZMAT *zm_load(FILE *fp,char **name); - -#else - -extern ZMAT *zm_save(); -extern ZVEC *zv_save(); -extern complex z_save(); -extern ZMAT *zm_load(); - -#endif - -#endif - -#endif //GO.SYSIN DD matlab.h echo matrix2.h 1>&2 sed >matrix2.h <<'//GO.SYSIN DD matrix2.h' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -/* - Header file for ``matrix2.a'' library file -*/ - - -#ifndef MATRIX2H -#define MATRIX2H - -#include "matrix.h" - -/* Unless otherwise specified, factorisation routines overwrite the - matrix that is being factorised */ - -#ifndef ANSI_C - -extern MAT *BKPfactor(), *CHfactor(), *LUfactor(), *QRfactor(), - *QRCPfactor(), *LDLfactor(), *Hfactor(), *MCHfactor(), - *m_inverse(); -extern double LUcondest(), QRcondest(); -extern MAT *makeQ(), *makeR(), *makeHQ(), *makeH(); -extern MAT *LDLupdate(), *QRupdate(); - -extern VEC *BKPsolve(), *CHsolve(), *LUsolve(), *_Qsolve(), *QRsolve(), - *LDLsolve(), *Usolve(), *Lsolve(), *Dsolve(), *LTsolve(), - *UTsolve(), *LUTsolve(), *QRCPsolve(); - -extern BAND *bdLUfactor(), *bdLDLfactor(); -extern VEC *bdLUsolve(), *bdLDLsolve(); - -extern VEC *hhvec(); -extern VEC *hhtrvec(); -extern MAT *hhtrrows(); -extern MAT *hhtrcols(); - -extern void givens(); -extern VEC *rot_vec(); /* in situ */ -extern MAT *rot_rows(); /* in situ */ -extern MAT *rot_cols(); /* in situ */ - - -/* eigenvalue routines */ -extern VEC *trieig(), *symmeig(); -extern MAT *schur(); -extern void schur_evals(); -extern MAT *schur_vecs(); - -/* singular value decomposition */ -extern VEC *bisvd(), *svd(); - -/* matrix powers and exponent */ -MAT *_m_pow(); -MAT *m_pow(); -MAT *m_exp(), *_m_exp(); -MAT *m_poly(); - -/* FFT */ -void fft(); -void ifft(); - - -#else - - /* forms Bunch-Kaufman-Parlett factorisation for - symmetric indefinite matrices */ -extern MAT *BKPfactor(MAT *A,PERM *pivot,PERM *blocks), - /* Cholesky factorisation of A - (symmetric, positive definite) */ - *CHfactor(MAT *A), - /* LU factorisation of A (with partial pivoting) */ - *LUfactor(MAT *A,PERM *pivot), - /* QR factorisation of A; need dim(diag) >= # rows of A */ - *QRfactor(MAT *A,VEC *diag), - /* QR factorisation of A with column pivoting */ - *QRCPfactor(MAT *A,VEC *diag,PERM *pivot), - /* L.D.L^T factorisation of A */ - *LDLfactor(MAT *A), - /* Hessenberg factorisation of A -- for schur() */ - *Hfactor(MAT *A,VEC *diag1,VEC *diag2), - /* modified Cholesky factorisation of A; - actually factors A+D, D diagonal with no - diagonal entry in the factor < sqrt(tol) */ - *MCHfactor(MAT *A,double tol), - *m_inverse(MAT *A,MAT *out); - - /* returns condition estimate for A after LUfactor() */ -extern double LUcondest(MAT *A,PERM *pivot), - /* returns condition estimate for Q after QRfactor() */ - QRcondest(MAT *A); - -/* Note: The make..() and ..update() routines assume that the factorisation - has already been carried out */ - - /* Qout is the "Q" (orthongonal) matrix from QR factorisation */ -extern MAT *makeQ(MAT *A,VEC *diag,MAT *Qout), - /* Rout is the "R" (upper triangular) matrix - from QR factorisation */ - *makeR(MAT *A,MAT *Rout), - /* Qout is orthogonal matrix in Hessenberg factorisation */ - *makeHQ(MAT *A,VEC *diag1,VEC *diag2,MAT *Qout), - /* Hout is the Hessenberg matrix in Hessenberg factorisation */ - *makeH(MAT *A,MAT *Hout); - - /* updates L.D.L^T factorisation for A <- A + alpha.u.u^T */ -extern MAT *LDLupdate(MAT *A,VEC *u,double alpha), - /* updates QR factorisation for QR <- Q.(R+u.v^T) - Note: we need explicit Q & R matrices, - from makeQ() and makeR() */ - *QRupdate(MAT *Q,MAT *R,VEC *u,VEC *v); - -/* Solve routines assume that the corresponding factorisation routine - has already been applied to the matrix along with auxiliary - objects (such as pivot permutations) - - These solve the system A.x = b, - except for LUTsolve and QRTsolve which solve the transposed system - A^T.x. = b. - If x is NULL on entry, then it is created. -*/ - -extern VEC *BKPsolve(MAT *A,PERM *pivot,PERM *blocks,VEC *b,VEC *x), - *CHsolve(MAT *A,VEC *b,VEC *x), - *LDLsolve(MAT *A,VEC *b,VEC *x), - *LUsolve(MAT *A,PERM *pivot,VEC *b,VEC *x), - *_Qsolve(MAT *A,VEC *,VEC *,VEC *, VEC *), - *QRsolve(MAT *A,VEC *,VEC *b,VEC *x), - *QRTsolve(MAT *A,VEC *,VEC *b,VEC *x), - - - /* Triangular equations solve routines; - U for upper triangular, L for lower traingular, D for diagonal - if diag_val == 0.0 use that values in the matrix */ - - *Usolve(MAT *A,VEC *b,VEC *x,double diag_val), - *Lsolve(MAT *A,VEC *b,VEC *x,double diag_val), - *Dsolve(MAT *A,VEC *b,VEC *x), - *LTsolve(MAT *A,VEC *b,VEC *x,double diag_val), - *UTsolve(MAT *A,VEC *b,VEC *x,double diag_val), - *LUTsolve(MAT *A,PERM *,VEC *,VEC *), - *QRCPsolve(MAT *QR,VEC *diag,PERM *pivot,VEC *b,VEC *x); - -extern BAND *bdLUfactor(BAND *A,PERM *pivot), - *bdLDLfactor(BAND *A); -extern VEC *bdLUsolve(BAND *A,PERM *pivot,VEC *b,VEC *x), - *bdLDLsolve(BAND *A,VEC *b,VEC *x); - - - -extern VEC *hhvec(VEC *,u_int,Real *,VEC *,Real *); -extern VEC *hhtrvec(VEC *,double,u_int,VEC *,VEC *); -extern MAT *hhtrrows(MAT *,u_int,u_int,VEC *,double); -extern MAT *hhtrcols(MAT *,u_int,u_int,VEC *,double); - -extern void givens(double,double,Real *,Real *); -extern VEC *rot_vec(VEC *,u_int,u_int,double,double,VEC *); /* in situ */ -extern MAT *rot_rows(MAT *,u_int,u_int,double,double,MAT *); /* in situ */ -extern MAT *rot_cols(MAT *,u_int,u_int,double,double,MAT *); /* in situ */ - - -/* eigenvalue routines */ - - /* compute eigenvalues of tridiagonal matrix - with diagonal entries a[i], super & sub diagonal entries - b[i]; eigenvectors stored in Q (if not NULL) */ -extern VEC *trieig(VEC *a,VEC *b,MAT *Q), - /* sets out to be vector of eigenvectors; eigenvectors - stored in Q (if not NULL). A is unchanged */ - *symmeig(MAT *A,MAT *Q,VEC *out); - - /* computes real Schur form = Q^T.A.Q */ -extern MAT *schur(MAT *A,MAT *Q); - /* computes real and imaginary parts of the eigenvalues - of A after schur() */ -extern void schur_evals(MAT *A,VEC *re_part,VEC *im_part); - /* computes real and imaginary parts of the eigenvectors - of A after schur() */ -extern MAT *schur_vecs(MAT *T,MAT *Q,MAT *X_re,MAT *X_im); - - -/* singular value decomposition */ - - /* computes singular values of bi-diagonal matrix with - diagonal entries a[i] and superdiagonal entries b[i]; - singular vectors stored in U and V (if not NULL) */ -VEC *bisvd(VEC *a,VEC *b,MAT *U,MAT *V), - /* sets out to be vector of singular values; - singular vectors stored in U and V */ - *svd(MAT *A,MAT *U,MAT *V,VEC *out); - -/* matrix powers and exponent */ -MAT *_m_pow(MAT *,int,MAT *,MAT *); -MAT *m_pow(MAT *,int, MAT *); -MAT *m_exp(MAT *,double,MAT *); -MAT *_m_exp(MAT *,double,MAT *,int *,int *); -MAT *m_poly(MAT *,VEC *,MAT *); - -/* FFT */ -void fft(VEC *,VEC *); -void ifft(VEC *,VEC *); - -#endif - - -#endif //GO.SYSIN DD matrix2.h echo oldnames.h 1>&2 sed >oldnames.h <<'//GO.SYSIN DD oldnames.h' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -/* macros for names used in versions 1.0 and 1.1 */ -/* 8/11/93 */ - - -#ifndef OLDNAMESH -#define OLDNAMESH - - -/* type IVEC */ - -#define get_ivec iv_get -#define freeivec IV_FREE -#define cp_ivec iv_copy -#define fout_ivec iv_foutput -#define out_ivec iv_output -#define fin_ivec iv_finput -#define in_ivec iv_input -#define dump_ivec iv_dump - - -/* type ZVEC */ - -#define get_zvec zv_get -#define freezvec ZV_FREE -#define cp_zvec zv_copy -#define fout_zvec zv_foutput -#define out_zvec zv_output -#define fin_zvec zv_finput -#define in_zvec zv_input -#define zero_zvec zv_zero -#define rand_zvec zv_rand -#define dump_zvec zv_dump - -/* type ZMAT */ - -#define get_zmat zm_get -#define freezmat ZM_FREE -#define cp_zmat zm_copy -#define fout_zmat zm_foutput -#define out_zmat zm_output -#define fin_zmat zm_finput -#define in_zmat zm_input -#define zero_zmat zm_zero -#define rand_zmat zm_rand -#define dump_zmat zm_dump - -/* types SPMAT */ - -#define sp_mat SPMAT -#define sp_get_mat sp_get -#define sp_free_mat sp_free -#define sp_cp_mat sp_copy -#define sp_cp_mat2 sp_copy2 -#define sp_fout_mat sp_foutput -#define sp_fout_mat2 sp_foutput2 -#define sp_out_mat sp_output -#define sp_out_mat2 sp_output2 -#define sp_fin_mat sp_finput -#define sp_in_mat sp_input -#define sp_zero_mat sp_zero -#define sp_dump_mat sp_dump - - -/* type SPROW */ - -#define sp_row SPROW -#define sp_get_idx sprow_idx -#define row_xpd sprow_xpd -#define sp_get_row sprow_get -#define row_set_val sprow_set_val -#define fout_row sprow_foutput -#define _row_mltadd sprow_mltadd -#define sp_row_copy sprow_copy -#define sp_row_merge sprow_merge -#define sp_row_ip sprow_ip -#define sp_row_sqr sprow_sqr - - -/* type MAT */ - -#define get_mat m_get -#define freemat M_FREE -#define cp_mat m_copy -#define fout_mat m_foutput -#define out_mat m_output -#define fin_mat m_finput -#define in_mat m_input -#define zero_mat m_zero -#define id_mat m_ident -#define rand_mat m_rand -#define ones_mat m_ones -#define dump_mat m_dump - -/* type VEC */ - -#define get_vec v_get -#define freevec V_FREE -#define cp_vec v_copy -#define fout_vec v_foutput -#define out_vec v_output -#define fin_vec v_finput -#define in_vec v_input -#define zero_vec v_zero -#define rand_vec v_rand -#define ones_vec v_ones -#define dump_vec v_dump - - -/* type PERM */ - -#define get_perm px_get -#define freeperm PX_FREE -#define cp_perm px_copy -#define fout_perm px_foutput -#define out_perm px_output -#define fin_perm px_finput -#define in_perm px_input -#define id_perm px_ident -#define px_id px_ident -#define trans_px px_transp -#define sign_px px_sign -#define dump_perm px_dump - -#endif //GO.SYSIN DD oldnames.h echo sparse.h 1>&2 sed >sparse.h <<'//GO.SYSIN DD sparse.h' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -/* - Header for sparse matrix stuff. - Basic sparse routines to be held in sparse.c -*/ - -/* RCS id: $Id: sparse.h,v 1.2 1994/01/13 05:33:36 des Exp $ */ - -#ifndef SPARSEH - -#define SPARSEH - - -#include "matrix.h" - - -/* basic sparse types */ - -typedef struct row_elt { - int col, nxt_row, nxt_idx; - Real val; - } row_elt; - -typedef struct SPROW { - int len, maxlen, diag; - row_elt *elt; /* elt[maxlen] */ - } SPROW; - -typedef struct SPMAT { - int m, n, max_m, max_n; - char flag_col, flag_diag; - SPROW *row; /* row[max_m] */ - int *start_row; /* start_row[max_n] */ - int *start_idx; /* start_idx[max_n] */ - } SPMAT; - -/* Note that the first allocated entry in column j is start_row[j]; - This starts the chain down the columns using the nxt_row and nxt_idx - fields of each entry in each row. */ - -typedef struct pair { int pos; Real val; } pair; - -typedef struct SPVEC { - int dim, max_dim; - pair *elt; /* elt[max_dim] */ - } SPVEC; - -#define SMNULL ((SPMAT*)NULL) -#define SVNULL ((SPVEC*)NULL) - -/* Macro for speedup */ -#define sprow_idx2(r,c,hint) \ - ( ( (hint) >= 0 && (hint) < (r)->len && \ - (r)->elt[hint].col == (c)) ? (hint) : sprow_idx((r),(c)) ) - - - -/* memory functions */ - -#ifdef ANSI_C -int sp_get_vars(int m,int n,int deg,...); -int sp_resize_vars(int m,int n,...); -int sp_free_vars(SPMAT **,...); -#elif VARARGS -int sp_get_vars(); -int sp_resize_vars(); -int sp_free_vars(); - -#endif - -/* Sparse Matrix Operations and Utilities */ -#ifndef ANSI_C -extern SPMAT *sp_get(), *sp_copy(), *sp_copy2(), - *sp_zero(), *sp_resize(), *sp_compact(); -extern double sp_get_val(), sp_set_val(); -extern VEC *sp_mv_mlt(), *sp_vm_mlt(); -extern int sp_free(); - -/* Access path operations */ -extern SPMAT *sp_col_access(); -extern SPMAT *sp_diag_access(); -extern int chk_col_access(); - -/* Input/output operations */ -extern SPMAT *sp_finput(); -extern void sp_foutput(), sp_foutput2(); - -/* algebraic operations */ -extern SPMAT *sp_smlt(), *sp_add(), *sp_sub(), *sp_mltadd(); - - -/* sparse row operations */ -extern SPROW *sprow_get(), *sprow_xpd(), *sprow_merge(), *sprow_mltadd(), - *sprow_resize(), *sprow_copy(); -extern SPROW *sprow_add(), *sprow_sub(), *sprow_smlt(); -extern double sprow_set_val(); -extern void sprow_foutput(); -extern int sprow_idx(), sprow_free(); - -/* dump */ -extern void sp_dump(), sprow_dump(); -extern MAT *sp_m2dense(); - -#else -SPMAT *sp_get(int,int,int), *sp_copy(SPMAT *), - *sp_copy2(SPMAT *,SPMAT *), - *sp_zero(SPMAT *), *sp_resize(SPMAT *,int,int), - *sp_compact(SPMAT *,double); -double sp_get_val(SPMAT *,int,int), sp_set_val(SPMAT *,int,int,double); -VEC *sp_mv_mlt(SPMAT *,VEC *,VEC *), *sp_vm_mlt(SPMAT *,VEC *,VEC *); -int sp_free(SPMAT *); - -/* Access path operations */ -SPMAT *sp_col_access(SPMAT *); -SPMAT *sp_diag_access(SPMAT *); -int chk_col_access(SPMAT *); - -/* Input/output operations */ -SPMAT *sp_finput(FILE *); -void sp_foutput(FILE *,SPMAT *), sp_foutput2(FILE *,SPMAT *); - -/* algebraic operations */ -SPMAT *sp_smlt(SPMAT *A,double alpha,SPMAT *B), - *sp_add(SPMAT *A,SPMAT *B,SPMAT *C), - *sp_sub(SPMAT *A,SPMAT *B,SPMAT *C), - *sp_mltadd(SPMAT *A,SPMAT *B,double alpha,SPMAT *C); - -/* sparse row operations */ -SPROW *sprow_get(int), *sprow_xpd(SPROW *r,int n,int type), - *sprow_resize(SPROW *r,int n,int type), - *sprow_merge(SPROW *,SPROW *,SPROW *,int type), - *sprow_copy(SPROW *,SPROW *,SPROW *,int type), - *sprow_mltadd(SPROW *,SPROW *,double,int,SPROW *,int type); -SPROW *sprow_add(SPROW *r1,SPROW *r2, int j0,SPROW *r_out, int type), - *sprow_sub(SPROW *r1,SPROW *r2, int j0,SPROW *r_out, int type), - *sprow_smlt(SPROW *r1,double alpha, int j0,SPROW *r_out, int type); -double sprow_set_val(SPROW *,int,double); -int sprow_free(SPROW *); -int sprow_idx(SPROW *,int); -void sprow_foutput(FILE *,SPROW *); - -/* dump */ -void sp_dump(FILE *fp, SPMAT *A); -void sprow_dump(FILE *fp, SPROW *r); -MAT *sp_m2dense(SPMAT *A,MAT *out); - -#endif - -/* MACROS */ - -#define sp_input() sp_finput(stdin) -#define sp_output(A) sp_foutput(stdout,(A)) -#define sp_output2(A) sp_foutput2(stdout,(A)) -#define row_mltadd(r1,r2,alpha,out) sprow_mltadd(r1,r2,alpha,0,out) -#define out_row(r) sprow_foutput(stdout,(r)) - -#define SP_FREE(A) ( sp_free((A)), (A)=(SPMAT *)NULL) - -/* utility for index computations -- ensures index returned >= 0 */ -#define fixindex(idx) ((idx) == -1 ? (error(E_BOUNDS,"fixindex"),0) : \ - (idx) < 0 ? -((idx)+2) : (idx)) - - -/* NOT USED */ - -/* loop over the columns in a row */ -/* -#define loop_cols(r,e,code) \ - do { int _r_idx; row_elt *e; SPROW *_t_row; \ - _t_row = (r); e = &(_t_row->elt); \ - for ( _r_idx = 0; _r_idx < _t_row->len; _r_idx++, e++ ) \ - { code; } } while ( 0 ) -*/ -/* loop over the rows in a column */ -/* -#define loop_cols(A,col,e,code) \ - do { int _r_num, _r_idx, _c; SPROW *_r; row_elt *e; \ - if ( ! (A)->flag_col ) sp_col_access((A)); \ - col_num = (col); \ - if ( col_num < 0 || col_num >= A->n ) \ - error(E_BOUNDS,"loop_cols"); \ - _r_num = (A)->start_row[_c]; _r_idx = (A)->start_idx[_c]; \ - while ( _r_num >= 0 ) { \ - _r = &((A)->row[_r_num]); \ - _r_idx = sprow_idx2(_r,_c,_r_idx); \ - if ( _r_idx < 0 ) continue; \ - e = &(_r->elt[_r_idx]); code; \ - _r_num = e->nxt_row; _r_idx = e->nxt_idx; \ - } } while ( 0 ) - -*/ - -#endif - //GO.SYSIN DD sparse.h echo sparse2.h 1>&2 sed >sparse2.h <<'//GO.SYSIN DD sparse2.h' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -/* Sparse matrix factorise/solve header */ -/* RCS id: $Id: sparse2.h,v 1.4 1994/01/13 05:33:46 des Exp $ */ - - - -#ifndef SPARSE2H - -#define SPARSE2H - -#include "sparse.h" - - -#ifdef ANSI_C -SPMAT *spCHfactor(SPMAT *), *spICHfactor(SPMAT *), *spCHsymb(SPMAT *); -VEC *spCHsolve(SPMAT *,VEC *,VEC *); - -SPMAT *spLUfactor(SPMAT *,PERM *,double); -SPMAT *spILUfactor(SPMAT *,double); -VEC *spLUsolve(SPMAT *,PERM *,VEC *,VEC *), - *spLUTsolve(SPMAT *,PERM *,VEC *,VEC *); - -SPMAT *spBKPfactor(SPMAT *, PERM *, PERM *, double); -VEC *spBKPsolve(SPMAT *, PERM *, PERM *, VEC *, VEC *); - -VEC *pccg(VEC *(*A)(),void *A_par,VEC *(*M_inv)(),void *M_par,VEC *b, - double tol,VEC *x); -VEC *sp_pccg(SPMAT *,SPMAT *,VEC *,double,VEC *); -VEC *cgs(VEC *(*A)(),void *A_par,VEC *b,VEC *r0,double tol,VEC *x); -VEC *sp_cgs(SPMAT *,VEC *,VEC *,double,VEC *); -VEC *lsqr(VEC *(*A)(),VEC *(*AT)(),void *A_par,VEC *b,double tol,VEC *x); -VEC *sp_lsqr(SPMAT *,VEC *,double,VEC *); -int cg_set_maxiter(int); - -void lanczos(VEC *(*A)(),void *A_par,int m,VEC *x0,VEC *a,VEC *b, - Real *beta_m1,MAT *Q); -void sp_lanczos(SPMAT *,int,VEC *,VEC *,VEC *,Real *,MAT *); -VEC *lanczos2(VEC *(*A)(),void *A_par,int m,VEC *x0,VEC *evals, - VEC *err_est); -VEC *sp_lanczos2(SPMAT *,int,VEC *,VEC *,VEC *); -extern void scan_to(SPMAT *,IVEC *,IVEC *,IVEC *,int); -extern row_elt *chase_col(SPMAT *,int,int *,int *,int); -extern row_elt *chase_past(SPMAT *,int,int *,int *,int); -extern row_elt *bump_col(SPMAT *,int,int *,int *); - -#else -extern SPMAT *spCHfactor(), *spICHfactor(), *spCHsymb(); -extern VEC *spCHsolve(); - -extern SPMAT *spLUfactor(); -extern SPMAT *spILUfactor(); -extern VEC *spLUsolve(), *spLUTsolve(); - -extern SPMAT *spBKPfactor(); -extern VEC *spBKPsolve(); - -extern VEC *pccg(), *sp_pccg(), *cgs(), *sp_cgs(), *lsqr(), *sp_lsqr(); -extern int cg_set_maxiter(); - -void lanczos(), sp_lanczos(); -VEC *lanczos2(), *sp_lanczos2(); -extern void scan_to(); -extern row_elt *chase_col(); -extern row_elt *chase_past(); -extern row_elt *bump_col(); - -#endif - - -#endif //GO.SYSIN DD sparse2.h echo zmatrix.h 1>&2 sed >zmatrix.h <<'//GO.SYSIN DD zmatrix.h' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -/* Main include file for zmeschach library -- complex vectors and matrices */ - -#ifndef ZMATRIXH -#define ZMATRIXH - -#include "matrix.h" - - - /* Type definitions for complex vectors and matrices */ - - -/* complex definition */ -typedef struct { - Real re,im; - } complex; - -/* complex vector definition */ -typedef struct { - u_int dim, max_dim; - complex *ve; - } ZVEC; - -/* complex matrix definition */ -typedef struct { - u_int m, n; - u_int max_m, max_n, max_size; - complex *base; /* base is base of alloc'd mem */ - complex **me; - } ZMAT; - -#define ZVNULL ((ZVEC *)NULL) -#define ZMNULL ((ZMAT *)NULL) - -#define Z_CONJ 1 -#define Z_NOCONJ 0 - - -/* memory functions */ - -#ifdef ANSI_C -int zv_get_vars(int dim,...); -int zm_get_vars(int m,int n,...); -int zv_resize_vars(int new_dim,...); -int zm_resize_vars(int m,int n,...); -int zv_free_vars(ZVEC **,...); -int zm_free_vars(ZMAT **,...); - -#elif VARARGS -int zv_get_vars(); -int zm_get_vars(); -int zv_resize_vars(); -int zm_resize_vars(); -int zv_free_vars(); -int zm_free_vars(); - -#endif - - - - -#ifdef ANSI_C -extern ZMAT *_zm_copy(ZMAT *in,ZMAT *out,u_int i0,u_int j0); -extern ZMAT * zm_move(ZMAT *, int, int, int, int, ZMAT *, int, int); -extern ZMAT *zvm_move(ZVEC *, int, ZMAT *, int, int, int, int); -extern ZVEC *_zv_copy(ZVEC *in,ZVEC *out,u_int i0); -extern ZVEC * zv_move(ZVEC *, int, int, ZVEC *, int); -extern ZVEC *zmv_move(ZMAT *, int, int, int, int, ZVEC *, int); -extern complex z_finput(FILE *fp); -extern ZMAT *zm_finput(FILE *fp,ZMAT *a); -extern ZVEC *zv_finput(FILE *fp,ZVEC *x); -extern ZMAT *zm_add(ZMAT *mat1,ZMAT *mat2,ZMAT *out); -extern ZMAT *zm_sub(ZMAT *mat1,ZMAT *mat2,ZMAT *out); -extern ZMAT *zm_mlt(ZMAT *A,ZMAT *B,ZMAT *OUT); -extern ZMAT *zmma_mlt(ZMAT *A,ZMAT *B,ZMAT *OUT); -extern ZMAT *zmam_mlt(ZMAT *A,ZMAT *B,ZMAT *OUT); -extern ZVEC *zmv_mlt(ZMAT *A,ZVEC *b,ZVEC *out); -extern ZMAT *zsm_mlt(complex scalar,ZMAT *matrix,ZMAT *out); -extern ZVEC *zvm_mlt(ZMAT *A,ZVEC *b,ZVEC *out); -extern ZMAT *zm_adjoint(ZMAT *in,ZMAT *out); -extern ZMAT *zswap_rows(ZMAT *A,int i,int j,int lo,int hi); -extern ZMAT *zswap_cols(ZMAT *A,int i,int j,int lo,int hi); -extern ZMAT *mz_mltadd(ZMAT *A1,ZMAT *A2,complex s,ZMAT *out); -extern ZVEC *zmv_mltadd(ZVEC *v1,ZVEC *v2,ZMAT *A,complex alpha,ZVEC *out); -extern ZVEC *zvm_mltadd(ZVEC *v1,ZVEC *v2,ZMAT *A,complex alpha,ZVEC *out); -extern ZVEC *zv_zero(ZVEC *x); -extern ZMAT *zm_zero(ZMAT *A); -extern ZMAT *zm_get(int m,int n); -extern ZVEC *zv_get(int dim); -extern ZMAT *zm_resize(ZMAT *A,int new_m,int new_n); -extern complex _zin_prod(ZVEC *x,ZVEC *y,u_int i0,u_int flag); -extern ZVEC *zv_resize(ZVEC *x,int new_dim); -extern ZVEC *zv_mlt(complex scalar,ZVEC *vector,ZVEC *out); -extern ZVEC *zv_add(ZVEC *vec1,ZVEC *vec2,ZVEC *out); -extern ZVEC *zv_mltadd(ZVEC *v1,ZVEC *v2,complex scale,ZVEC *out); -extern ZVEC *zv_sub(ZVEC *vec1,ZVEC *vec2,ZVEC *out); -#ifdef PROTOTYPES_IN_STRUCT -extern ZVEC *zv_map(complex (*f)(),ZVEC *x,ZVEC *out); -extern ZVEC *_zv_map(complex (*f)(),void *params,ZVEC *x,ZVEC *out); -#else -extern ZVEC *zv_map(complex (*f)(complex),ZVEC *x,ZVEC *out); -extern ZVEC *_zv_map(complex (*f)(void *,complex),void *params,ZVEC *x,ZVEC *out); -#endif -extern ZVEC *zv_lincomb(int n,ZVEC *v[],complex a[],ZVEC *out); -extern ZVEC *zv_linlist(ZVEC *out,ZVEC *v1,complex a1,...); -extern ZVEC *zv_star(ZVEC *x1, ZVEC *x2, ZVEC *out); -extern ZVEC *zv_slash(ZVEC *x1, ZVEC *x2, ZVEC *out); -extern int zm_free(ZMAT *mat); -extern int zv_free(ZVEC *vec); - -extern ZVEC *zv_rand(ZVEC *x); -extern ZMAT *zm_rand(ZMAT *A); - -extern ZVEC *zget_row(ZMAT *A, int i, ZVEC *out); -extern ZVEC *zget_col(ZMAT *A, int j, ZVEC *out); -extern ZMAT *zset_row(ZMAT *A, int i, ZVEC *in); -extern ZMAT *zset_col(ZMAT *A, int j, ZVEC *in); - -extern ZVEC *px_zvec(PERM *pi, ZVEC *in, ZVEC *out); -extern ZVEC *pxinv_zvec(PERM *pi, ZVEC *in, ZVEC *out); - -extern void __zconj__(complex zp[], int len); -extern complex __zip__(complex zp1[],complex zp2[],int len,int flag); -extern void __zmltadd__(complex zp1[],complex zp2[], - complex s,int len,int flag); -extern void __zmlt__(complex zp[],complex s,complex out[],int len); -extern void __zadd__(complex zp1[],complex zp2[],complex out[],int len); -extern void __zsub__(complex zp1[],complex zp2[],complex out[],int len); -extern void __zzero__(complex zp[],int len); -extern void z_foutput(FILE *fp,complex z); -extern void zm_foutput(FILE *fp,ZMAT *a); -extern void zv_foutput(FILE *fp,ZVEC *x); -extern void zm_dump(FILE *fp,ZMAT *a); -extern void zv_dump(FILE *fp,ZVEC *x); - -extern double _zv_norm1(ZVEC *x, VEC *scale); -extern double _zv_norm2(ZVEC *x, VEC *scale); -extern double _zv_norm_inf(ZVEC *x, VEC *scale); -extern double zm_norm1(ZMAT *A); -extern double zm_norm_inf(ZMAT *A); -extern double zm_norm_frob(ZMAT *A); - -complex zmake(double real, double imag); -double zabs(complex z); -complex zadd(complex z1,complex z2); -complex zsub(complex z1,complex z2); -complex zmlt(complex z1,complex z2); -complex zinv(complex z); -complex zdiv(complex z1,complex z2); -complex zsqrt(complex z); -complex zexp(complex z); -complex zlog(complex z); -complex zconj(complex z); -complex zneg(complex z); -#else -extern ZMAT *_zm_copy(); -extern ZVEC *_zv_copy(); -extern ZMAT *zm_finput(); -extern ZVEC *zv_finput(); -extern ZMAT *zm_add(); -extern ZMAT *zm_sub(); -extern ZMAT *zm_mlt(); -extern ZMAT *zmma_mlt(); -extern ZMAT *zmam_mlt(); -extern ZVEC *zmv_mlt(); -extern ZMAT *zsm_mlt(); -extern ZVEC *zvm_mlt(); -extern ZMAT *zm_adjoint(); -extern ZMAT *zswap_rows(); -extern ZMAT *zswap_cols(); -extern ZMAT *mz_mltadd(); -extern ZVEC *zmv_mltadd(); -extern ZVEC *zvm_mltadd(); -extern ZVEC *zv_zero(); -extern ZMAT *zm_zero(); -extern ZMAT *zm_get(); -extern ZVEC *zv_get(); -extern ZMAT *zm_resize(); -extern ZVEC *zv_resize(); -extern complex _zin_prod(); -extern ZVEC *zv_mlt(); -extern ZVEC *zv_add(); -extern ZVEC *zv_mltadd(); -extern ZVEC *zv_sub(); -extern ZVEC *zv_map(); -extern ZVEC *_zv_map(); -extern ZVEC *zv_lincomb(); -extern ZVEC *zv_linlist(); -extern ZVEC *zv_star(); -extern ZVEC *zv_slash(); - -extern ZVEC *px_zvec(); -extern ZVEC *pxinv_zvec(); - -extern ZVEC *zv_rand(); -extern ZMAT *zm_rand(); - -extern ZVEC *zget_row(); -extern ZVEC *zget_col(); -extern ZMAT *zset_row(); -extern ZMAT *zset_col(); - -extern int zm_free(); -extern int zv_free(); -extern void __zconj__(); -extern complex __zip__(); -extern void __zmltadd__(); -extern void __zmlt__(); -extern void __zadd__(); -extern void __zsub__(); -extern void __zzero__(); -extern void zm_foutput(); -extern void zv_foutput(); -extern void zm_dump(); -extern void zv_dump(); - -extern double _zv_norm1(); -extern double _zv_norm2(); -extern double _zv_norm_inf(); -extern double zm_norm1(); -extern double zm_norm_inf(); -extern double zm_norm_frob(); - -complex zmake(); -double zabs(); -complex zadd(); -complex zsub(); -complex zmlt(); -complex zinv(); -complex zdiv(); -complex zsqrt(); -complex zexp(); -complex zlog(); -complex zconj(); -complex zneg(); -#endif - -#define zv_copy(x,y) _zv_copy(x,y,0) -#define zm_copy(A,B) _zm_copy(A,B,0,0) - -#define z_input() z_finput(stdin) -#define zv_input(x) zv_finput(stdin,x) -#define zm_input(A) zm_finput(stdin,A) -#define z_output(z) z_foutput(stdout,z) -#define zv_output(x) zv_foutput(stdout,x) -#define zm_output(A) zm_foutput(stdout,A) - -#define ZV_FREE(x) ( zv_free(x), (x) = ZVNULL ) -#define ZM_FREE(A) ( zm_free(A), (A) = ZMNULL ) - -#define zin_prod(x,y) _zin_prod(x,y,0,Z_CONJ) - -#define zv_norm1(x) _zv_norm1(x,VNULL) -#define zv_norm2(x) _zv_norm2(x,VNULL) -#define zv_norm_inf(x) _zv_norm_inf(x,VNULL) - - -#endif //GO.SYSIN DD zmatrix.h echo zmatrix2.h 1>&2 sed >zmatrix2.h <<'//GO.SYSIN DD zmatrix2.h' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - - -/* - 2nd header file for Meschach's complex routines. - This file contains declarations for complex factorisation/solve - routines. - -*/ - - -#ifndef ZMATRIX2H -#define ZMATRIX2H - -#include "zmatrix.h" - -#ifdef ANSI_C -extern ZVEC *zUsolve(ZMAT *matrix, ZVEC *b, ZVEC *out, double diag); -extern ZVEC *zLsolve(ZMAT *matrix, ZVEC *b, ZVEC *out, double diag); -extern ZVEC *zUAsolve(ZMAT *U, ZVEC *b, ZVEC *out, double diag); -extern ZVEC *zDsolve(ZMAT *A, ZVEC *b, ZVEC *x); -extern ZVEC *zLAsolve(ZMAT *L, ZVEC *b, ZVEC *out, double diag); - -extern ZVEC *zhhvec(ZVEC *,int,Real *,ZVEC *,complex *); -extern ZVEC *zhhtrvec(ZVEC *,double,int,ZVEC *,ZVEC *); -extern ZMAT *zhhtrrows(ZMAT *,int,int,ZVEC *,double); -extern ZMAT *zhhtrcols(ZMAT *,int,int,ZVEC *,double); -extern ZMAT *zHfactor(ZMAT *,ZVEC *); -extern ZMAT *zHQunpack(ZMAT *,ZVEC *,ZMAT *,ZMAT *); - -extern ZMAT *zQRfactor(ZMAT *A, ZVEC *diag); -extern ZMAT *zQRCPfactor(ZMAT *A, ZVEC *diag, PERM *px); -extern ZVEC *_zQsolve(ZMAT *QR, ZVEC *diag, ZVEC *b, ZVEC *x, ZVEC *tmp); -extern ZMAT *zmakeQ(ZMAT *QR, ZVEC *diag, ZMAT *Qout); -extern ZMAT *zmakeR(ZMAT *QR, ZMAT *Rout); -extern ZVEC *zQRsolve(ZMAT *QR, ZVEC *diag, ZVEC *b, ZVEC *x); -extern ZVEC *zQRAsolve(ZMAT *QR, ZVEC *diag, ZVEC *b, ZVEC *x); -extern ZVEC *zQRCPsolve(ZMAT *QR,ZVEC *diag,PERM *pivot,ZVEC *b,ZVEC *x); -extern ZVEC *zUmlt(ZMAT *U, ZVEC *x, ZVEC *out); -extern ZVEC *zUAmlt(ZMAT *U, ZVEC *x, ZVEC *out); -extern double zQRcondest(ZMAT *QR); - -extern ZVEC *zLsolve(ZMAT *, ZVEC *, ZVEC *, double); -extern ZMAT *zset_col(ZMAT *, int, ZVEC *); - -extern ZMAT *zLUfactor(ZMAT *A, PERM *pivot); -extern ZVEC *zLUsolve(ZMAT *A, PERM *pivot, ZVEC *b, ZVEC *x); -extern ZVEC *zLUAsolve(ZMAT *LU, PERM *pivot, ZVEC *b, ZVEC *x); -extern ZMAT *zm_inverse(ZMAT *A, ZMAT *out); -extern double zLUcondest(ZMAT *LU, PERM *pivot); - -extern void zgivens(complex, complex, Real *, complex *); -extern ZMAT *zrot_rows(ZMAT *A, int i, int k, double c, complex s, - ZMAT *out); -extern ZMAT *zrot_cols(ZMAT *A, int i, int k, double c, complex s, - ZMAT *out); -extern ZVEC *rot_zvec(ZVEC *x, int i, int k, double c, complex s, - ZVEC *out); -extern ZMAT *zschur(ZMAT *A,ZMAT *Q); -/* extern ZMAT *schur_vecs(ZMAT *T,ZMAT *Q,X_re,X_im) */ -#else -extern ZVEC *zUsolve(), *zLsolve(), *zUAsolve(), *zDsolve(), *zLAsolve(); - -extern ZVEC *zhhvec(); -extern ZVEC *zhhtrvec(); -extern ZMAT *zhhtrrows(); -extern ZMAT *zhhtrcols(); -extern ZMAT *zHfactor(); -extern ZMAT *zHQunpack(); - - -extern ZMAT *zQRfactor(), *zQRCPfactor(); -extern ZVEC *_zQsolve(); -extern ZMAT *zmakeQ(), *zmakeR(); -extern ZVEC *zQRsolve(), *zQRAsolve(), *zQRCPsolve(); -extern ZVEC *zUmlt(), *zUAmlt(); -extern double zQRcondest(); - -extern ZVEC *zLsolve(); -extern ZMAT *zset_col(); - -extern ZMAT *zLUfactor(); -extern ZVEC *zLUsolve(), *zLUAsolve(); -extern ZMAT *zm_inverse(); -extern double zLUcondest(); - -extern void zgivens(); -extern ZMAT *zrot_rows(), *zrot_cols(); -extern ZVEC *rot_zvec(); -extern ZMAT *zschur(); -/* extern ZMAT *schur_vecs(); */ -#endif - -#endif - //GO.SYSIN DD zmatrix2.h mkdir DOC echo DOC/fnindex.txt 1>&2 sed >DOC/fnindex.txt <<'//GO.SYSIN DD DOC/fnindex.txt' 's/^-//' - - FUNCTION INDEX - ============== - -In the descriptions below, matrices are represented by capital letters, -vectors by lower case letters and scalars by alpha. - - Function Description - -band2mat() Convert band matrix to dense matrix -bd_free() Deallocate (destroy) band matrix -bd_get() Allocate and initialise band matrix -bd_transp() Transpose band matrix -bd_resize() Resize band matrix -bdLDLfactor() Band LDL^T factorisation -bdLDLsolve() Solve Ax=b using band LDL^T factors -bdLUfactor() Band LU factorisation -bdLUsolve() Solve Ax=b using band LU factors -bisvd() SVD of bi-diagonal matrix -BKPfactor() Bunch-Kaufman-Parlett factorisation -BKPsolve() Bunch-Kaufman-Parlett solver -catch() Catch a raised error (macro) -catchall() Catch any raised error (macro) -catch_FPE() Catch floating point error (sets flag) -CHfactor() Dense Cholesky factorisation -CHsolve() Cholesky solver -d_save() Save real in MATLAB format -Dsolve() Solve Dx=y , D diagonal -ERRABORT() Abort on error (sets flag, macro) -ERREXIT() Exit on error (sets flag, macro) -error() Raise an error (macro, see ev_err()) -err_list_attach() Attach new list of errors -err_list_free() Discard list of errors -err_is_list_attached() Checks for an error list -ev_err() Raise an error (function) -fft() Computes Fast Fourier Transform -finput() Input a simple data item from a stream -fprompter() Print prompt to stderr -get_col() Extract a column from a matrix -get_row() Extract a row from a matrix -givens() Compute Givens parameters -hhtrcols() Compute AP^T where P is a Householder matrix -hhtrrows() Compute PA where P is a Householder matrix -hhtrvec() Compute Px where P is a Householder matrix -hhvec() Compute parameters for a Householder matrix -ifft() Computes inverse FFT -in_prod() Inner product of vectors -input() Input a simple data item from stdin (macro) -iter_arnoldi() Arnoldi iterative method -iter_arnoldi_iref() Arnoldi iterative method with refinement -iter_ATx() Set A^T in ITER structure -iter_Ax() Set A in ITER structure -iter_Bx() Set preconditioner in ITER structure -iter_cg() Conjugate gradients iterative method -iter_cgne() Conjugate gradients for normal equations -iter_cgs() CGS iterative method -iter_copy() Copy ITER data structures -iter_copy2() Shallow copy of ITER data structures -iter_dump() Dump ITER data structure to a stream -iter_free() Free (deallocate) ITER structure -iter_get() Allocate ITER structure -iter_gmres() GMRES iterative method -iter_lanczos() Lanczos iterative method -iter_lanczos2() Lanczos method with Cullum and Willoughby extensions -iter_lsqr() LSQR iterative method -iter_mgcr() MGCR iterative method -iter_resize() Resize vectors in an ITER data structure -iter_spcg() Sparse matrix CG method -iter_spcgne() Sparse matrix CG method for normal equations -iter_spcgs() Sparse matrix CGS method -iter_spgmres() Sparse matrix GMRES method -iter_splsqr() Sparse matrix LSQR method -iter_spmgcr() Sparse matrix MGCR method -iv_add() Add integer vectors -iv_copy() Copy integer vector -iv_dump() Dump integer vector to a stream -iv_finput() Input integer vector from a stream -iv_foutput() Output integer vector to a stream -IV_FREE() Free (deallocate) an integer vector (macro) -iv_free() Free (deallocate) integer vector (function) -iv_free_vars() Free a list of integer vectors -iv_get() Allocate and initialise an integer vector -iv_get_vars() Allocate list of integer vectors -iv_input() Input integer vector from stdin (macro) -iv_output() Output integer vector to stdout (macro) -iv_resize() Resize an integer vector -iv_resize_vars() Resize a list of integer vectors -iv_sub() Subtract integer vectors -LDLfactor() LDL^T factorisation -LDLsolve() LDL^T solver -LDLupdate() Update LDL^T factorisation -Lsolve() Solve Lx=y , L lower triangular -LTsolve() Solve L^Tx=y , L lower triangular -LUcondest() Estimate a condition number using LU factors -LUfactor() Compute LU factors with implicit scaled partial pivoting -LUsolve() Solve Ax=b using LU factors -LUTsolve() Solve A^Tx=b usng LU factors -m_add() Add matrices -makeQ() Form Q matrix for QR factorisation -makeR() Form R matrix for QR factorisation -mat2band() Extract band matrix from dense matrix -MCHfactor() Modified Cholesky factorisation - (actually factors A+D, D diagonal, instead of A) -m_copy() Copy dense matrix -m_dump() Dump matrix data structure to a stream -mem_attach_list() Adds a new family of types -mem_bytes() Notify change in memory usage (macro) -mem_bytes_list() Notify change in memory usage -mem_free_list() Frees a family of types -mem_info_bytes() Number of bytes used by a type -mem_info_numvar() Number of structures of a type -mem_info_file() Print memory info to a stream -mem_info_is_on() Is memory data being accumulated? -mem_info_on() Turns memory info system on/off -mem_is_list_attached() Is list of types attached? -mem_numvar() Notify change in number of structures allocated (macro) -mem_numvar_list() Notify change in number of structures allocated -mem_stat_dump() Prints information on registered workspace -mem_stat_free() Frees (deallocates) static workspace -mem_stat_mark() Sets mark for workspace -MEM_STAT_REG() Register static workspace (macro) -mem_stat_show_mark() Current workspace group -m_exp() Computes matrix exponential -m_finput() Input matrix from a stream -m_foutput() Output matrix to a stream -M_FREE() Free (deallocate) a matrix (macro) -m_free() Free (deallocate) matrix (function) -m_free_vars() Free a list of matrices -m_get() Allocate and initialise a matrix -m_get_vars() Allocate list of matrices -m_ident() Sets matrix to identity matrix -m_input() Input matrix from stdin (macro) -m_inverse() Invert matrix -m_load() Load matrix in MATLAB format -m_mlt() Multiplies matrices -mmtr_mlt() Computes AB^T -m_norm1() Computes ||A||_1 of a matrix -m_norm_frob() Computes the Frobenius norm of a matrix -m_norm_inf() Computes ||A||_inf of a matrix -m_ones() Set matrix to all 1's -m_output() Output matrix to stdout (macro) -m_poly() Computes a matrix polynomial -m_pow() Computes integer power of a matrix -mrand() Generates pseudo-random real number -m_rand() Randomise entries of a matrix -mrandlist() Generates array of pseudo-random numbers -m_resize() Resize matrix -m_resize_vars() Resize a list of matrices -m_save() Save matrix in MATLAB format -m_sub() Subtract matrices -m_transp() Transpose matrix -mtrm_mlt() Computes A^TB -mv_mlt() Computes Ax -mv_mltadd() Computes y <- Ax+y -m_zero() Zero a matrix -ON_ERROR() Error handler (macro) -prompter() Print prompt message to stdout -px_cols() Permute the columns of a matrix -px_copy() Copy permutation -px_dump() Dump permutation data structure to a stream -px_finput() Input permutation from a stream -px_foutput() Output permutation to a stream -PX_FREE() Free (deallocate) a permutation (macro) -px_free() Free (deallocate) permutation (function) -px_free_vars() Free a list of permutations -px_get() Allocate and initialise a permutation -px_get_vars() Allocate a list of permutations -px_ident() Sets permutation to identity -px_input() Input permutation from stdin (macro) -px_inv() Invert permutation -pxinv_vec() Computes P^Tx where P is a permutation matrix -pxinv_zvec() Computes P^Tx where P is a permutation matrix (complex) -px_mlt() Multiply permutations -px_output() Output permutation to stdout (macro) -px_resize() Resize a permutation -px_resize_vars() Resize a list of permutations -px_rows() Permute the rows of a matrix -px_sign() Returns the sign of the permutation -px_transp() Transpose a pair of entries -px_vec() Computes Px where P is a permutation matrix -px_zvec() Computes Px where P is a permutation matrix (complex) -QRCPfactor() QR factorisation with column pivoting -QRfactor() QR factorisation -QRsolve() Solve Ax=b using QR factorisation -QRTsolve() Solve A^Tx=b using QR factorisation -QRupdate() Update explicit QR factors -rot_cols() Apply Givens rotation to the columns of a matrix -rot_rows() Apply Givens rotation to the rows of a matrix -rot_vec() Apply Givens rotation to a vector -rot_zvec() Apply complex Givens rotation to a vector -schur() Compute real Schur form -schur_evals() Compute eigenvalues from the real Schur form -schur_vecs() Compute eigenvectors from the real Schur form -set_col() Set the column of a matrix to a given vector -set_err_flag() Control behaviour of ev_err() -set_row() Set the row of a matrix to a given vector -sm_mlt() Scalar-matrix multiplication -smrand() Set seed for mrand() -spBKPfactor() Sparse symmetric indefinite factorsiation -spBKPsolve() Sparse symmetric indefinite solver -spCHfactor() Sparse Cholesky factorisation -spCHsolve() Sparse Cholesky solver -spCHsymb() Symbolic sparse Cholesky factorisation - (no floating point operations) -sp_col_access() Sets up column access paths for a sparse matrix -sp_compact() Eliminates zero entries in a sparse matrix -sp_copy() Copies a sparse matrix -sp_copy2() Copies a sparse matrix into another -sp_diag_access() Sets up diagonal access paths for a sparse matrix -sp_dump() Dump sparse matrix data structure to a stream -sp_finput() Input sparse matrix from a stream -sp_foutput() Output a sparse matrix to a stream -sp_free() Free (deallocate) a sparse matrix -sp_get() Allocate and initialise a sparse matrix -sp_get_val() Get the (i,j) entry of a sparse matrix -spICHfactor() Sparse incomplete Cholesky factorisation -sp_input() Input a sparse matrix form stdin -spLUfactor() Sparse LU factorisation using partial pivoting -spLUsolve() Solves Ax=b using sparse LU factors -spLUTsolve() Solves A^Tx=b using sparse LU factors -sp_mv_mlt() Computes Ax for sparse A -sp_output() Outputs a sparse matrix to a stream (macro) -sp_resize() Resize a sparse matrix -sprow_add() Adds a pair of sparse rows -sprow_foutput() Output sparse row to a stream -sprow_get() Allocate and initialise a sparse row -sprow_get_idx() Get location of an entry in a sparse row -sprow_merge() Merge two sparse rows -sprow_mltadd() Sparse row vector multiply-and-add -sprow_set_val() Set an entry in a sparse row -sprow_smlt() Multiplies a sparse row by a scalar -sprow_sub() Subtracts a sparse row from another -sprow_xpd() Expand a sparse row -sp_set_val() Set the (i,j) entry of a sparse matrix -sp_vm_mlt() Compute x^TA for sparse A -sp_zero() Zero (but do not remove) all entries of a sparse matrix -svd() Compute the SVD of a matrix -sv_mlt() Scalar-vector multiply -symmeig() Compute eigenvalues/vectors of a symmetric matrix -tracecatch() Catch and re-raise errors (macro) -trieig() Compute eigenvalues/vectors of a symmetric tridiagonal matrix -Usolve() Solve Ux=b where U is upper triangular -UTsolve() Solve U^Tx=b where U is upper triangular -v_add() Add vectors -v_conv() Convolution product of vectors -v_copy() Copy vector -v_dump() Dump vector data structure to a stream -v_finput() Input vector from a stream -v_foutput() Output vector to a stream -V_FREE() Free (deallocate) a vector (macro) -v_free() Free (deallocate) vector (function) -v_free_vars() Free a list of vectors -v_get() Allocate and initialise a vector -v_get_vars() Allocate list of vectors -v_input() Input vector from stdin (macro) -v_lincomb() Compute sum of a_i x_i for an array of vectors -v_linlist() Compute sum of a_i x_i for a list of vectors -v_map() Apply function componentwise to a vector -v_max() Computes max vector entry and index -v_min() Computes min vector entry and index -v_mltadd() Computes y <- alpha*x+y for vectors x , y -vm_mlt() Computes x^TA -vm_mltadd() Computes y^T <- y^T+x^TA -v_norm1() Computes ||x||_1 for a vector -v_norm2() Computes ||x||_2 (the Euclidean norm) of a vector -v_norm_inf() Computes ||x||_inf for a vector -v_ones() Set vector to all 1's -v_output() Output vector to stdout (macro) -v_pconv() Periodic convolution of two vectors -v_rand() Randomise entries of a vector -v_resize() Resize a vector -v_resize_vars() Resize a list of vectors -v_save() Save a vector in MATLAB format -v_slash() Computes componentwise ratio of vectors -v_sort() Sorts vector components -v_star() Componentwise vector product -v_sub() Subtract two vectors -v_sum() Sum of components of a vector -v_zero() Zero a vector -zabs() Complex absolute value (modulus) -zadd() Add complex numbers -zconj() Conjugate complex number -zdiv() Divide complex numbers -zexp() Complex exponential -z_finput() Read complex number from file or stream -z_foutput() Prints complex number to file or stream -zgivens() Compute complex Givens' rotation -zhhtrcols() Apply Householder transformation: PA (complex) -zhhtrrows() Apply Householder transformation: AP (complex) -zhhtrvec() Apply Householder transformation: Px (complex) -zhhvec() Compute Householder transformation -zin_prod() Complex inner product -z_input() Read complex number from stdin -zinv() Computes 1/z (complex) -zLAsolve() Solve L^*x=b , L complex lower triangular -zlog() Complex logarithm -zLsolve() Solve Lx=b , L complex lower triangular -zLUAsolve() Solve A^*x=b using complex LU factorisation - (A^* - adjoint of A, A is complex) -zLUcondest() Complex LU condition estimate -zLUfactor() Complex LU factorisation -zLUsolve() Solve Ax=b using complex LU factorisation -zm_add() Add complex matrices -zm_adjoint() Computes adjoint of complex matrix -zmake() Construct complex number from real and imaginary parts -zmakeQ() Construct Q matrix for complex QR -zmakeR() Construct R matrix for complex QR -zmam_mlt() Computes A^*B (complex) -zm_dump() Dump complex matrix to stream -zm_finput() Input complex matrix from stream -ZM_FREE() Free (deallocate) complex matrix (macro) -zm_free() Free (deallocate) complex matrix (function) -zm_free_vars() Free a list of complex matrices -zm_get() Allocate complex matrix -zm_get_vars() Allocate a list of complex matrices -zm_input() Input complex matrix from stdin -zm_inverse() Compute inverse of complex matrix -zm_load() Load complex matrix in MATLAB format -zmlt() Multiply complex numbers -zmma_mlt() Computes AB^* (complex) -zm_mlt() Multiply complex matrices -zm_norm1() Complex matrix 1-norm -zm_norm_frob() Complex matrix Frobenius norm -zm_norm_inf() Complex matrix infinity-norm -zm_rand() Randomise complex matrix -zm_resize() Resize complex matrix -zm_resize_vars() Resize a list of complex matrices -zm_save() Save complex matrix in MATLAB format -zm_sub() Subtract complex matrices -zmv_mlt() Complex matrix-vector multiply -zmv_mltadd() Complex matrix-vector multiply and add -zm_zero() Zero complex matrix -zneg() Computes -z (complex) -z_output() Print complex number to stdout -zQRCPfactor() Complex QR factorisation with column pivoting -zQRCPsolve() Solve Ax = b using complex QR factorisation -zQRfactor() Complex QR factorisation -zQRAsolve() Solve A^*x = b using complex QR factorisation -zQRsolve() Solve Ax = b using complex QR factorisation -zrot_cols() Complex Givens' rotation of columns -zrot_rows() Complex Givens' rotation of rows -z_save() Save complex number in MATLAB format -zschur() Complex Schur factorisation -zset_col() Set column of complex matrix -zset_row() Set row of complex matrix -zsm_mlt() Complex scalar-matrix product -zsqrt() Square root z (complex) -zsub() Subtract complex numbers -zUAsolve() Solve U^*x=b , U complex upper triangular -zUsolve() Solve Ux=b , U complex upper triangular -zv_add() Add complex vectors -zv_copy() Copy complex vector -zv_dump() Dump complex vector to a stream -zv_finput() Input complex vector from a stream -ZV_FREE() Free (deallocate) complex vector (macro) -zv_free() Free (deallocate) complex vector (function) -zv_free_vars() Free a list of complex vectors -zv_get() Allocate complex vector -zv_get_vars() Allocate a list of complex vectors -zv_input() Input complex vector from a stdin -zv_lincomb() Compute sum of a_i x_i for an array of vectors -zv_linlist() Compute sum of a_i x_i for a list of vectors -zv_map() Apply function componentwise to a complex vector -zv_mlt() Complex scalar-vector product -zv_mltadd() Complex scalar-vector multiply and add -zvm_mlt() Computes A^*x (complex) -zvm_mltadd() Computes A^*x+y (complex) -zv_norm1() Complex vector 1-norm vnorm1() -zv_norm2() Complex vector 2-norm (Euclidean norm) -zv_norm_inf() Complex vector infinity- (or supremum) norm -zv_rand() Randomise complex vector -zv_resize() Resize complex vector -zv_resize_vars() Resize a list of complex vectors -zv_save() Save complex vector in MATLAB format -zv_slash() Componentwise ratio of complex vectors -zv_star() Componentwise product of complex vectors -zv_sub() Subtract complex vectors -zv_sum() Sum of components of a complex vector -zv_zero() Zero complex vector - - - - Low level routines - - - Function Description - -__add__() Add arrays -__ip__() Inner product of arrays -MEM_COPY() Copy memory (macro) -MEM_ZERO() Zero memory (macro) -__mltadd__() Forms x+ alpha*y for arrays -__smlt__() Scalar-vector multiplication for arrays -__sub__() Subtract an array from another -__zadd__() Add complex arrays -__zconj__() Conjugate complex array -__zero__() Zero an array -__zip__() Complex inner product of arrays -__zmlt__() Complex array scalar product -__zmltadd__() Complex array saxpy -__zsub__() Subtract complex arrays -__zzero__() Zero a complex array - - //GO.SYSIN DD DOC/fnindex.txt echo DOC/tutorial.txt 1>&2 sed >DOC/tutorial.txt <<'//GO.SYSIN DD DOC/tutorial.txt' 's/^-//' - - - MESCHACH VERSION 1.2A - --------------------- - - - TUTORIAL - ======== - - - In this manual the basic data structures are introduced, and some of the -more basic operations are illustrated. Then some examples of how to use -the data structures and procedures to solve some simple problems are given. -The first example program is a simple 4th order Runge-Kutta solver for -ordinary differential equations. The second is a general least squares -equation solver for over-determined equations. The third example -illustrates how to solve a problem involving sparse matrices. These -examples illustrate the use of matrices, matrix factorisations and solving -systems of linear equations. The examples described in this manual are -implemented in tutorial.c. - - While the description of each aspect of the system is brief and far from -comprehensive, the aim is to show the different aspects of how to set up -programs and routines and how these work in practice, which includes I/O -and error-handling issues. - - - -1. THE DATA STRUCTURES AND SOME BASIC OPERATIONS - - The three main data structures are those describing vectors, matrices -and permutations. These have been used to create data structures for -simplex tableaus for linear programming, and used with data structures for -sparse matrices etc. To use the system reliably, you should always use -pointers to these data structures and use library routines to do all the -necessary initialisation. - - In fact, for the operations that involve memory management (creation, -destruction and resizing), it is essential that you use the routines -provided. - - For example, to create a matrix A of size 34 , a vector x of dimension -10, and a permutation p of size 10, use the following code: - - - #include "matrix.h" - .............. - main() - { - MAT *A; - VEC *x; - PERM *p; - .......... - A = m_get(3,4); - x = v_get(10); - p = px_get(10); - .......... - } - - - This initialises these data structures to have the given size. The -matrix A and the vector x are initially all zero, while p is initially the -identity permutation. - - They can be disposed of by calling M_FREE(A), V_FREE(x) and PX_FREE(p) -respectively if you need to re-use the memory for something else. The -elements of each data structure can be accessed directly using the members -(or fields) of the corresponding structures. For example the (i,j) -component of A is accessed by A->me[i][j], x_i by x->ve[i] and p_i by -p->pe[i]. - - Their sizes are also directly accessible: A->m and A->n are the number -of rows and columns of A respectively, x->dim is the dimension of x , and -size of p is p->size. - - Note that the indexes are zero relative just as they are in ordinary C, -so that the index i in x->ve[i] can range from 0 to x->dim -1 . Thus the -total number of entries of a vector is exactly x->dim. - - While this alone is sufficient to allow a programmer to do any desired -operation with vectors and matrices it is neither convenient for the -programmer, nor efficient use of the CPU. A whole library has been -implemented to reduce the burden on the programmer in implementing -algorithms with vectors and matrices. For instance, to copy a vector from -x to y it is sufficient to write y = v_copy(x,VNULL). The VNULL is the -NULL vector, and usually tells the routine called to create a vector for -output. - - Thus, the v_copy function will create a vector which has the same size -as x and all the components are equal to those of x. If y has already -been created then you can write y = v_copy(x,y); in general, writing -``v_copy(x,y);'' is not enough! If y is NULL, then it is created (to have -the correct size, i.e. the same size as x), and if it is the wrong size, -then it is resized to have the correct size (i.e. same size as x). Note -that for all the following functions, the output value is returned, even if -you have a non-NULL value as the output argument. This is the standard -across the entire library. - - Addition, subtraction and scalar multiples of vectors can be computed by -calls to library routines: v_add(x,y,out), v_sub(x,y,out), sv_mlt(s,x,out) -where x and y are input vectors (with data type VEC *), out is the output -vector (same data type) and s is a double precision number (data type -double). There is also a special combination routine, which computes -out=v_1+s,v_2 in a single routine: v_mltadd(v1,v2,s,out). This is not only -extremely useful, it is also more efficient than using the scalar-vector -multiply and vector addition routines separately. - - Inner products can be computed directly: in_prod(x,y) returns the inner -product of x and y. Note that extended precision evaluation is not -guaranteed. The standard installation options uses double precision -operations throughout the library. - - Equivalent operations can be performed on matrices: m_add(A,B,C) which -returns C=A+B , and sm_mlt(s,A,C) which returns C=sA . The data types of -A, B and C are all MAT *, while that of s is type double as before. The -matrix NULL is called MNULL. - - Multiplying matrices and vectors can be done by a single function call: -mv_mlt(A,x,out) returns out=A*x while vm_mlt(A,x,out) returns out=A^T*x , or -equivalently, out^T=x^T*A . Note that there is no distinction between row -and column vectors unlike certain interactive environments such as MATLAB -or MATCALC. - - Permutations are also an essential part of the package. Vectors can be -permuted by using px_vec(p,x,p_x), rows and columns of matrices can be -permuted by using px_rows(p,A,p_A), px_cols(p,A,A_p), and permutations can -be multiplied using px_mlt(p1,p2,p1_p2) and inverted using px_inv(p,p_inv). -The NULL permutation is called PXNULL. - - There are also utility routines to initialise or re-initialise these -data structures: v_zero(x), m_zero(A), m_ident(A) (which sets A=I of the -correct size), v_rand(x), m_rand(A) which sets the entries of x and A -respectively to be randomly and uniformly selected between zero and one, -and px_ident(p) which sets p to be an identity permutation. - - Input and output are accomplished by library routines v_input(x), -m_input(A), and px_input(p). If a null object is passed to any of these -input routines, all data will be obtained from the input file, which is -stdin. If input is taken from a keyboard then the user will be prompted -for all the data items needed; if input is taken from a file, then the -input will have to be of the same format as that produced by the output -routines, which are: v_output(x), m_output(A) and px_output(p). This -output is both human and machine readable! - - If you wish to send the data to a file other than the standard output -device stdout, or receive input from a file or device other than the -standard input device stdin, take the appropriate routine above, use the -``foutpout'' suffix instead of just ``output'', and add a file pointer as -the first argument. For example, to send a matrix A to a file called -``fred'', use the following: - - - #include "matrix.h" - ............. - main() - { - FILE *fp; - MAT *A; - ............. - fp = fopen("fred","w"); - m_foutput(fp,A); - ............. - } - - - These input routines allow for the presence of comments in the data. A -comment in the input starts with a ``hash'' character ``#'', and continues -to the end of the line. For example, the following is valid input for a -3-dimensional vector: - - # The initial vector must not be zero - # x = - Vector: dim: 3 - -7 0 3 - - - For general input/output which conforms to this format, allowing -comments in the input files, use the input() and finput() macros. These -are used to print out a prompt message if stdin is a terminal (or ``tty'' -in Unix jargon), and to skip over any comments if input is from a -non-interactive device. An example of the usage of these macros is: - - input("Input number of steps: ","%d",&steps); - fp = stdin; - finput(fp,"Input number of steps: ","%d",&steps); - fp = fopen("fred","r"); - finput(fp,"Input number of steps: ","%d",&steps); - -The "%d" is one of the format specifiers which are used in fscanf(); the -last argument is the pointer to the variable (unless the variable is a -string) just as for scanf() and fscanf(). The first two macro calls read -input from stdin, the last from the file fred. If, in the first two calls, -stdin is a keyboard (a ``tty'' in Unix jargon) then the prompt string - "Input number of steps: " -is printed out on the terminal. - - - The second part of the library contains routines for various -factorisation methods. To use it put - - #include "matrix2.h" - -at the beginning of your program. It contains factorisation and solution -routines for LU, Cholesky and QR-factorisation methods, as well as update -routines for Cholesky and QR factorisations. Supporting these are a number -of Householder transformation and Givens' rotation routines. Also there is -a routine for generating the Q matrix for a QR-factorisation, if it is -needed explicitly, as it often is. -There are routines for band factorisation and solution for LU and LDL^T -factorisations. - -For using complex numbers, vectors and matrices include - - #include "zmatrix.h" - -for using the basic routines, and - - #include "zmatrix2.h" - -for the complex matrix factorisation routines. The zmatrix2.h file -includes matrix.h and zmatrix.h so you don't need these files included -together. - -For using the sparse matrix routines in the library you need to put - - #include "sparse.h" - -or, if you use any sparse factorisation routines, - - #include "sparse2.h" - -at the beginning of your file. The routines contained in the library -include routines for creating, destroying, initialising and updating sparse -matrices, and also routines for sparse matrix-dense vector multiplication, -sparse LU factorisation and sparse Cholesky factorisation. - -For using the iterative routines you need to use - - #include "iter.h" - -This includes the sparse.h and matrix.h file. -There are also routines for applying iterative methods such as -pre-conditioned conjugate gradient methods to sparse matrices. - - And if you use the standard maths library (sin(), cos(), tan(), exp(), -log(), sqrt(), acos() etc.) don't forget to include the standard -mathematics header: - - #include <math.h> - -This file is not automatically included by any of the Meschach -header files. - - - -2. HOW TO MANAGE MEMORY - - Unlike many other numerical libraries, Meschach allows you to allocate, -deallocate and resize the vectors, matrices and permutations that you are -using. To gain maximum benefit from this it is sometimes necessary to -think a little about where memory is allocated and deallocated. There are -two reasons for this. - - Memory allocation, deallocation and resizing takes a significant amount -of time compared with (say) vector operations, so it should not be done too -frequently. Allocating memory but not deallocating it means that it cannot -be used by any other data structure. Data structures that are no longer -needed should be explicitly deallocated, or kept as static variables for -later use. Unlike other interpreted systems (such as Lisp) there is no -implicit ``garbage collection'' of no-longer-used memory. - - There are three main strategies that are recommended for deciding how to -allocate, deallocate and resize objects. These are ``no deallocation'' -which is really only useful for demonstration programs, ``allocate and -deallocate'' which minimises overall memory requirements at the expense of -speed, and ``resize on demand'' which is useful for routines that are -called repeatedly. A new technique for static workspace arrays is to -``register workspace variables''. - - -2.1 NO DEALLOCATION - - This is the strategy of allocating but never deallocating data -structures. This is only useful for demonstration programs run with small -to medium size data structures. For example, there could be a line - - QR = m_copy(A,MNULL); /* allocate memory for QR */ - -to allocate the memory, but without the call M_FREE(QR); in it. This can -be acceptable if QR = m_copy(A,MNULL) is only executed once, and so the -allocated memory never needs to be explicitly deallocated. - - This would not be acceptable if QR = m_copy(A,MNULL) occurred inside a -for loop. If this were so, then memory would be ``lost'' as far as the -program is concerned until there was insufficient space for allocating the -next matrix for QR. The next subsection shows how to avoid this. - - -2.2 ALLOCATE AND DEALLOCATE - - This is the most straightforward way of ensuring that memory is not -lost. With the example of allocating QR it would work like this: - - for ( ... ; ... ; ... ) - { - QR = m_copy(A,MNULL); /* allocate memory for QR */ - /* could have been allocated by m_get() */ - /* use QR */ - ...... - ...... - /* no longer need QR for this cycle */ - M_FREE(QR); /* deallocate QR so memory can be reused */ - } - - The allocate and deallocate statements could also have come at the -beginning and end of a function or procedure, so that when the function -returns, all the memory that the function has allocated has been -deallocated. - - This is most suitable for functions or sections of code that are called -repeatedly but involve fairly extensive calculations (at least a -matrix-matrix multiply, or solving a system of equations). - - -2.3 RESIZE ON DEMAND - - This technique reduces the time involved in memory allocation for code -that is repeatedly called or used, especially where the same size matrix or -vector is needed. For example, the vectors v1, v2, etc. in the -Runge-Kutta routine rk4() are allocated according to this strategy: - - rk4(...,x,...) - { - static VEC *v1=VNULL, *v2=VNULL, *v3=VNULL, *v4=VNULL, *temp=VNULL; - ....... - v1 = v_resize(v1,x->dim); - v2 = v_resize(v2,x->dim); - v3 = v_resize(v3,x->dim); - v4 = v_resize(v4,x->dim); - temp = v_resize(temp,x->dim); - ....... - } - - The intention is that the rk4() routine is called repeatedly with the -same size x vector. It then doesn't make as much sense to allocate v1, v2 -etc. whenever the function is called. Instead, v_resize() only performs -memory allocation if the memory already allocated to v1, v2 etc. is smaller -than x->dim. - - The vectors v1, v2 etc. are declared to be static to ensure that their -values are not lost between function calls. Variables that are declared -static are set to NULL or zero by default. So the declaration of v1, v2, -etc., could be - - static VEC *v1, *v2, *v3, *v4, *temp; - - This strategy of resizing static workspace variables is not so useful if -the object being allocated is extremely large. The previous ``allocate and -deallocate'' strategy is much more efficient for memory in those -circumstances. However, the following section shows how to get the best of -both worlds. - - -2.4 REGISTRATION OF WORKSPACE - - From version 1.2 onwards, workspace variables can be registered so that -the memory they reference can be freed up on demand. To do this, the -function containing the static workspace variables has to include calls to -MEM_STAT_REG(var,type) where var is a pointer to a Meschach data type (such -as VEC or MAT). This call should be placed after the call to the -appropriate resize function. The type parameter should be a TYPE_... macro -where the ``...'' is the name of a Meschach type such as VEC or MAT. For -example, - - rk4(...,x,...) - { - static VEC *v1, *v2, *v3, *v4, *temp; - ....... - v1 = v_resize(v1,x->dim); - MEM_STAT_REG(v1,TYPE_VEC); - v2 = v_resize(v2,x->dim); - MEM_STAT_REG(v2,TYPE_VEC); - ...... - } - -Normally, these registered workspace variables remain allocated. However, -to implement the ``deallocate on exit'' approach, use the following code: - - ...... - mem_stat_mark(1); - rk4(...,x,...) - mem_stat_free(1); - ...... - - To keep the workspace vectors allocated for the duration of a loop, but -then deallocated, use - - ...... - mem_stat_mark(1); - for (i = 0; i < N; i++ ) - rk4(...,x,...); - mem_stat_free(1); - ...... - -The number used in the mem_stat_mark() and mem_stat_free() calls is the -workspace group number. The call mem_stat_mark(1) designates 1 as the -current workspace group number; the call mem_stat_free(1) deallocates (and -sets to NULL) all static workspace variables registered as belonging to -workspace group 1. - - - -3. SIMPLE VECTOR OPERATIONS: AN RK4 ROUTINE - - The main purpose of this example is to show how to deal with vectors and -to compute linear combinations. - - The problem here is to implement the standard 4th order Runge-Kutta -method for the ODE - - x'=f(t,x), x(t_0)=x_0 - -for x(t_i), i=1,2,3, where t_i=t_0+i*h and h is the step size. - - The formulae for the 4th order Runge-Kutta method are: - - x_i+1 = x_i+ h/6*(v_1+2*v_2+2*v_3+v_4), -where - v_1 = f(t_i,x_i) - v_2 = f(t_i+h, x_i+h*v_1) - v_3 = f(t_i+h, x_i+h*v_2) - v_4 = f(t_i+h, x_i+h*v_3) - -where the v_i are vectors. - - The procedure for implementing this method (rk4()) will be passed (a -pointer to) the function f. The implementation of f could, in this system, -create a vector to hold the return value each time it is called. However, -such a scheme is memory intensive and the calls to the memory allocation -functions could easily dominate the time performed doing numerical -computations. So, the implementation of f will also be passed an already -allocated vector to be filled in with the appropriate values. - - The procedure rk4() will also be passed the current time t, the step -size h, and the current value for x. The time after the step will be -returned by rk4(). - -The code that does this follows. - - - #include "matrix.h" - - /* rk4 - 4th order Runge-Kutta method */ - double rk4(f,t,x,h) - double t, h; - VEC *(*f)(), *x; - { - static VEC *v1=VNULL, *v2=VNULL, *v3=VNULL, *v4=VNULL; - static VEC *temp=VNULL; - - /* do not work with NULL initial vector */ - if ( x == VNULL ) - error(E_NULL,"rk4"); - - /* ensure that v1, ..., v4, temp are of the correct size */ - v1 = v_resize(v1,x->dim); - v2 = v_resize(v2,x->dim); - v3 = v_resize(v3,x->dim); - v4 = v_resize(v4,x->dim); - temp = v_resize(temp,x->dim); - - /* register workspace variables */ - MEM_STAT_REG(v1,TYPE_VEC); - MEM_STAT_REG(v2,TYPE_VEC); - MEM_STAT_REG(v3,TYPE_VEC); - MEM_STAT_REG(v4,TYPE_VEC); - MEM_STAT_REG(temp,TYPE_VEC); - /* end of memory allocation */ - - (*f)(t,x,v1); /* most compilers allow: f(t,x,v1); */ - v_mltadd(x,v1,0.5*h,temp); /* temp = x+.5*h*v1 */ - (*f)(t+0.5*h,temp,v2); - v_mltadd(x,v2,0.5*h,temp); /* temp = x+.5*h*v2 */ - (*f)(t+0.5*h,temp,v3); - v_mltadd(x,v3,h,temp); /* temp = x+h*v3 */ - (*f)(t+h,temp,v4); - - /* now add: v1+2*v2+2*v3+v4 */ - v_copy(v1,temp); /* temp = v1 */ - v_mltadd(temp,v2,2.0,temp); /* temp = v1+2*v2 */ - v_mltadd(temp,v3,2.0,temp); /* temp = v1+2*v2+2*v3 */ - v_add(temp,v4,temp); /* temp = v1+2*v2+2*v3+v4 */ - - /* adjust x */ - v_mltadd(x,temp,h/6.0,x); /* x = x+(h/6)*temp */ - - return t+h; /* return the new time */ - } - - - Note that the last parameter of f() is where the output is placed. -Often this can be NULL in which case the appropriate data structure is -allocated and initialised. Note also that this routine can be used for -problems of arbitrary size, and the dimension of the problem is determined -directly from the data given. The vectors v_1,...,v_4 are created to have -the correct size in the lines - - .... - v1 = v_resize(v1,x->dim); - v2 = v_resize(v2,x->dim); - .... - - Here v_resize(v,dim) resizes the VEC structure v to hold a vector of -length dim. If v is initially NULL, then this creates a new vector of -dimension dim, just as v_get(dim) would do. For the above piece of code to -work correctly, v1, v2 etc., must be initialised to be NULL vectors. This -is done by the declaration - - static VEC *v1=VNULL, *v2=VNULL, *v3=VNULL, *v4=VNULL; - -or - - static VEC *v1, *v2, *v3, *v4; - -The operations of vector addition and scalar addition are really the only -vector operations that need to be performed in rk4. Vector addition is -done by v_add(v1,v2,out), where out=v1+v2, and scalar multiplication by -sv_mlt(scale,v,out), where out=scale*v. - -These can be combined into a single operation v_mltadd(v1,v2,scale,out), -where out=v1+scale*v2. As many operations in numerical mathematics involve -accumulating scalar multiples, this is an extremely useful operation, as we -can see above. For example: - - v_mltadd(x,v1,0.5*h,temp); /* temp = x+0.5*h*v1 */ - - We also need a number of ``utility'' operations. For example v_copy(in, -out) copies the vector in to out. There is also v_zero(v) to zero a vector -v. - - Here is an implementation of the function f for simple harmonic motion: - - /* f - right-hand side of ODE solver */ - VEC *f(t,x,out) - VEC *x, *out; - double t; - { - if ( x == VNULL || out == VNULL ) - error(E_NULL,"f"); - if ( x->dim != 2 || out->dim != 2 ) - error(E_SIZES,"f"); - - out->ve[0] = x->ve[1]; - out->ve[1] = - x->ve[0]; - - return out; - } - - As can be seen, most of this code is error checking code, which, of -course, makes the routine safer but a little slower. For a procedure like -f() it is probably not necessary, although then the main program would have -to perform checking to ensure that the vectors involved have the correct -size etc. The ith component of a vector x is x->ve[i], and indexing is -zero-relative (i.e., the ``first'' component is component 0). The ODE -described above is for simple harmonic motion: - - x_0'=x_1 , x_1'=-x_0 , or equivalently, x_0''+ x_0 = 0 . - - Here is the main program: - - - #include <stdio.h> - #include "matrix.h" - - main() - { - VEC *x; - VEC *f(); - double h, t, t_fin; - double rk4(); - - input("Input initial time: ", "%lf", &t); - input("Input final time: ", "%lf", &t_fin); - x = v_get(2); /* this is the size needed by f() */ - prompter("Input initial state:\n"); x = v_input(VNULL); - input("Input step size: ", "%lf", &h); - - printf("# At time %g, the state is\n",t); - v_output(x); - while ( t < t_fin ) - { - t = rk4(f,t,x,min(h,t_fin-t)); /* new t is returned */ - printf("# At time %g, the state is\n",t); - v_output(x); - t += h; - } - } - - The initial values are entered as a vector by v_input(). If v_input() -is passed a vector, then this vector will be used to store the input, and -this vector has the size that x had on entry to v_input(). The original -values of x are also used as a prompt on input from a tty. If a NULL is -passed to v_input() then v_input() will return a vector of whatever size -the user inputs. So, to ensure that only a two-dimensional vector is used -for the initial conditions (which is what f() is expecting) we use - - x = v_get(2); x = v_input(x); - - To compile the program under Unix, if it is in a file tutorial.c: - - cc -o tutorial tutorial.c meschach.a - -or, if you have an ANSI compiler, - - cc -DANSI_C -o tutorial tutorial.c meschach.a - - Here is a sample session with the above program: - - tutorial - - Input initial time: 0 - Input final time: 1 - Input initial state: - Vector: dim: 2 - entry 0: -1 - entry 1: b - entry 0: old -1 new: 1 - entry 1: old 0 new: 0 - Input step size: 0.1 - At time 0, the state is - Vector: dim: 2 - 1 0 - At time 0.1, the state is - Vector: dim: 2 - 0.995004167 -0.0998333333 - ................. - At time 1, the state is - Vector: dim: 2 - 0.540302967 -0.841470478 - - By way of comparison, the state at t=1 for the true solution is - x_0(1)=0.5403023058 , x_1(1)=-0.8414709848 . -The ``b'' that is typed in entering the x vector allows the user to alter -previously entered components. In this case once this is done, the user is -prompted with the old values when entering the new values. The user can -also type in ``f'' for skipping over the vector's components, which are -then unchanged. If an incorrectly sized initial value vector x is given, -the error handler comes into action: - - Input initial time: 0 - Input final time: 1 - Input initial state: - Vector: dim: 3 - entry 0: 3 - entry 1: 2 - entry 2: -1 - Input step size: 0.1 - At time 0, the state is - Vector: dim: 3 - 3 2 -1 - - "tutorial.c", line 79: sizes of objects don't match in function f() - Sorry, aborting program - - The error handler prints out the error message giving the source code -file and line number as well as the function name where the error was -raised. The relevant section of f() in file tutorial.c is: - - if ( x->dim != 2 || out->dim != 2 ) - error(E_SIZES,"f"); /* line 79 */ - - - The standard routines in this system perform error checking of this -type, and also checking for undefined results such as division by zero in -the routines for solving systems of linear equations. There are also error -messages for incorrectly formatted input and end-of-file conditions. - - To round off the discussion of this program, note that we have seen -interactive input of vectors. If the input file or stream is not a tty -(e.g., a file, a pipeline or a device) then it expects the input to have -the same form as the output for each of the data structures. Each of the -input routines (v_input(), m_input(), px_input()) skips over ``comments'' -in the input data, as do the macros input() and finput(). Anything from a -`#' to the end of the line (or EOF) is considered to be a comment. For -example, the initial value problem could be set up in a file ivp.dat as: - - # Initial time - 0 - # Final time - 1 - # Solution is x(t) = (cos(t),-sin(t)) - # x(0) = - Vector: dim: 2 - 1 0 - # Step size - 0.1 - - The output of the above program with the above input (from a file) gives -essentially the same output as shown above, except that no prompts are sent -to the screen. - - - -4. USING ROUTINES FOR LISTS OF ARGUMENTS - - Some of the most common routines have variants that take a variable -number of arguments. These are the routines .._get_vars(), .._resize_vars() -and .._free_vars(). These correspond to the the basic routines .._get(), -.._resize() and .._free() respectively. Also there is the -mem_stat_reg_vars() routine which registers a list of static workspace -variables. This corresponds to mem_stat_reg_list() for a single variable. - - Here is an example of how to use these functions. This example also -uses the routine v_linlist() to compute a linear combination of vectors. -Note that the code is much more compact, but don't forget that these -``..._vars()'' routines usually need the address-of operator ``&'' and NULL -termination of the arguments to work correctly. - - - #include "matrix.h" - - /* rk4 - 4th order Runge-Kutta method */ - double rk4(f,t,x,h) - double t, h; - VEC *(*f)(), *x; - { - static VEC *v1, *v2, *v3, *v4, *temp; - - /* do not work with NULL initial vector */ - if ( x == VNULL ) - error(E_NULL,"rk4"); - - /* ensure that v1, ..., v4, temp are of the correct size */ - v_resize_vars(x->dim, &v1, &v2, &v3, &v4, &temp, NULL); - - /* register workspace variables */ - mem_stat_reg_vars(0, TYPE_VEC, &v1, &v2, &v3, &v4, &temp, NULL); - /* end of memory allocation */ - - (*f)(t,x,v1); v_mltadd(x,v1,0.5*h,temp); - (*f)(t+0.5*h,temp,v2); v_mltadd(x,v2,0.5*h,temp); - (*f)(t+0.5*h,temp,v3); v_mltadd(x,v3,h,temp); - (*f)(t+h,temp,v4); - - /* now add: temp = v1+2*v2+2*v3+v4 */ - v_linlist(temp, v1, 1.0, v2, 2.0, v3, 2.0, v4, 1.0, VNULL); - /* adjust x */ - v_mltadd(x,temp,h/6.0,x); /* x = x+(h/6)*temp */ - - return t+h; /* return the new time */ - } - - - -5. A LEAST SQUARES PROBLEM - - Here we need to use matrices and matrix factorisations (in particular, a -QR factorisation) in order to find the best linear least squares solution -to some data. Thus in order to solve the (approximate) equations - A*x = b, -where A is an m x n matrix (m > n) we really need to solve the optimisation -problem - min_x ||Ax-b||^2. - - If we write A=QR where Q is an orthogonal m x m matrix and R is an upper -triangular m x n matrix then (we use 2-norm) - - ||A*x-b||^2 = ||R*x-Q^T*b||^2 = || R_1*x - Q_1^T*b||^2 + ||Q_2^T*b||^2 - -where R_1 is an n x n upper triangular matrix. If A has full rank then R_1 -will be an invertible matrix, and the best least squares solution of A*x=b -is x= R_1^{-1}*Q_1^T*b . - - These calculations can be be done quite easily as there is a QRfactor() -function available with the system. QRfactor() is declared to have the -prototype - - MAT *QRfactor(MAT *A, VEC *diag); - - The matrix A is overwritten with the factorisation of A ``in compact -form''; that is, while the upper triangular part of A is indeed the R -matrix described above, the Q matrix is stored as a collection of -Householder vectors in the strictly lower triangular part of A and in the -diag vector. The QRsolve() function knows and uses this compact form and -solves Q*R*x=b with the call QRsolve(A,diag,b,x), which also returns x. - - Here is the code to obtain the matrix A, perform the QR factorisation, -obtain the data vector b, solve for x, and determine what the norm of the -errors ( ||Ax-b||_2 ) is. - - - #include "matrix2.h" - - main() - { - MAT *A, *QR; - VEC *b, *x, *diag; - - /* read in A matrix */ - printf("Input A matrix:"); - - A = m_input(MNULL); /* A has whatever size is input */ - - if ( A->m < A->n ) - { - printf("Need m >= n to obtain least squares fit"); - exit(0); - } - printf("# A ="); m_output(A); - diag = v_get(A->m); - - /* QR is to be the QR factorisation of A */ - QR = m_copy(A,MNULL); - QRfactor(QR,diag); - - /* read in b vector */ - printf("Input b vector:"); - b = v_get(A->m); - b = v_input(b); - printf("# b ="); v_output(b); - - /* solve for x */ - x = QRsolve(QR,diag,b,VNULL); - printf("Vector of best fit parameters is"); - v_output(x); - - /* ... and work out norm of errors... */ - printf("||A*x-b|| = %g\n", - v_norm2(v_sub(mv_mlt(A,x,VNULL),b,VNULL))); - } - - Note that as well as the usual memory allocation functions like m_get(), -the I/O functions like m_input() and m_output(), and the -factorise-and-solve functions QRfactor() and QRsolve(), there are also -functions for matrix-vector multiplication: - mv_mlt(MAT *A, VEC *x, VEC *out) -and also vector-matrix multiplication (with the vector on the left): - vm_mlt(MAT *A, VEC *x, VEC *out), -with out=x^T A. There are also functions to perform matrix arithmetic - -matrix addition m_add(), matrix-scalar multiplication sm_mlt(), -matrix-matrix multiplication m_mlt(). - - Several different sorts of matrix factorisation are supported: LU -factorisation (also known as Gaussian elimination) with partial pivoting, -by LUfactor() and LUsolve(). Other factorisation methods include Cholesky -factorisation CHfactor() and CHsolve(), and QR factorisation with column -pivoting QRCPfactor(). - - Pivoting involve permutations which have their own PERM data structure. -Permutations can be created by px_get(), read and written by px_input() and -px_output(), multiplied by px_mlt(), inverted by px_inv() and applied to -vectors by px_vec(). - -The above program can be put into a file leastsq.c and compiled under Unix -using - - cc -o leastsq leastsq.c meschach.a -lm - -A sample session using leastsq follows: - - - Input A matrix: - Matrix: rows cols:5 3 - row 0: - entry (0,0): 3 - entry (0,1): -1 - entry (0,2): 2 - Continue: - row 1: - entry (1,0): 2 - entry (1,1): -1 - entry (1,2): 1 - Continue: n - row 1: - entry (1,0): old 2 new: 2 - entry (1,1): old -1 new: -1 - entry (1,2): old 1 new: 1.2 - Continue: - row 2: - entry (2,0): old 0 new: 2.5 - .... - .... (Data entry) - .... - # A = - Matrix: 5 by 3 - row 0: 3 -1 2 - row 1: 2 -1 1.2 - row 2: 2.5 1 -1.5 - row 3: 3 1 1 - row 4: -1 1 -2.2 - Input b vector: - entry 0: old 0 new: 5 - entry 1: old 0 new: 3 - entry 2: old 0 new: 2 - entry 3: old 0 new: 4 - entry 4: old 0 new: 6 - # b = - Vector: dim: 5 - 5 3 2 4 6 - Vector of best fit parameters is - Vector: dim: 3 - 1.47241555 -0.402817858 -1.14411815 - ||A*x-b|| = 6.78938 - - - The Q matrix can be obtained explicitly by the routine makeQ(). The Q -matrix can then be used to obtain an orthogonal basis for the range of A . -An orthogonal basis for the null space of A can be obtained by finding the -QR-factorisation of A^T . - - - -6. A SPARSE MATRIX EXAMPLE - - To illustrate the sparse matrix routines, consider the problem of -solving Poisson's equation on a square using finite differences, and -incomplete Cholesky factorisation. The actual equations to solve are - - u_{i,j+1} + u_{i,j-1} + u_{i+1,j} + u_{i-1,j} - 4*u_{i,j} = - h^2*f(x_i,y_j), for i,j=1,...,N - -where u_{0,j} = u_{i,0} = u_{N+1,j} = u_{i,N+1} = 0 for i,j=1,...,N and h -is the common distance between grid points. - - The first task is to set up the matrix describing this system of linear -equations. The next is to set up the right-hand side. The third is to -form the incomplete Cholesky factorisation of this matrix, and finally to -use the sparse matrix conjugate gradient routine with the incomplete -Cholesky factorisation as preconditioner. - - Setting up the matrix and right-hand side can be done by the following -code: - - - #define N 100 - #define index(i,j) (N*((i)-1)+(j)-1) - ...... - A = sp_get(N*N,N*N,5); - b = v_get(N*N); - h = 1.0/(N+1); /* for a unit square */ - ...... - - for ( i = 1; i <= N; i++ ) - for ( j = 1; j <= N; j++ ) - { - if ( i < N ) - sp_set_val(A,index(i,j),index(i+1,j),-1.0); - if ( i > 1 ) - sp_set_val(A,index(i,j),index(i-1,j),-1.0); - if ( j < N ) - sp_set_val(A,index(i,j),index(i,j+1),-1.0); - if ( j > 1 ) - sp_set_val(A,index(i,j),index(i,j-1),-1.0); - sp_set_val(A,index(i,j),index(i,j),4.0); - b->ve[index(i,j)] = -h*h*f(h*i,h*j); - } - - Once the matrix and right-hand side are set up, the next task is to -compute the sparse incomplete Cholesky factorisation of A. This must be -done in a different matrix, so A must be copied. - - LLT = sp_copy(A); - spICHfactor(LLT); - -Now when that is done, the remainder is easy: - - out = v_get(A->m); - ...... - iter_spcg(A,LLT,b,1e-6,out,1000,&num_steps); - printf("Number of iterations = %d\n",num_steps); - ...... - -and the output can be used in whatever way desired. - - For graphical output of the results, the solution vector can be copied -into a square matrix, which is then saved in MATLAB format using m_save(), -and graphical output can be produced by MATLAB. - - - -7. HOW DO I ....? - - For the convenience of the user, here a number of common tasks that -people need to perform frequently, and how to perform the computations -using Meschach. - - -7.1 .... SOLVE A SYSTEM OF LINEAR EQUATIONS ? - - If you wish to solve Ax=b for x given A and b (without destroying A), -then the following code will do this: - - VEC *x, *b; - MAT *A, *LU; - PERM *pivot; - ...... - LU = m_get(A->m,A->n); - LU = m_copy(A,LU); - pivot = px_get(A->m); - LUfactor(LU,pivot); - /* set values of b here */ - x = LUsolve(LU,pivot,b,VNULL); - - -7.2 .... SOLVE A LEAST-SQUARES PROBLEM ? - - To minimise ||Ax-b||_2^2 = sum_i ((Ax)_i-b_i)^2, the most reliable -method is based on the QR-factorisation. The following code performs this -calculation assuming that A is m x n with m > n : - - MAT *A, *QR; - VEC *diag, *b, *x; - ...... - QR = m_get(A->m,A->n); - QR = m_copy(A,QR); - diag = v_get(A->n); - QRfactor(QR,diag); - /* set values of b here */ - x = QRsolve(QR,diag,b,x); - - -7.3 .... FIND ALL THE EIGENVALUES (AND EIGENVECTORS) OF A GENERAL MATRIX ? - - The best method is based on the Schur decomposition. For symmetric -matrices, the eigenvalues and eigenvectors can be computed by a single call -to symmeig(). For non-symmetric matrices, the situation is more complex -and the problem of finding eigenvalues and eigenvectors can become quite -ill-conditioned. Provided the problem is not too ill-conditioned, the -following code should give accurate results: - - - /* A is the matrix whose eigenvalues and eigenvectors are sought */ - MAT *A, *T, *Q, *X_re, *X_im; - VEC *evals_re, *evals_im; - ...... - Q = m_get(A->m,A->n); - T = m_copy(A,MNULL); - - /* compute Schur form: A = Q*T*Q^T */ - schur(T,Q); - - /* extract eigenvalues */ - evals_re = v_get(A->m); - evals_im = v_get(A->m); - schur_evals(T,evals_re,evals_im); - - /* Q not needed for eiegenvalues */ - X_re = m_get(A->m,A->n); - X_im = m_get(A->m,A->n); - schur_vecs(T,Q,X_re,X_im); - /* k'th eigenvector is k'th column of (X_re + i*X_im) */ - - - -7.4 .... SOLVE A LARGE, SPARSE, POSITIVE DEFINITE SYSTEM OF EQUATIONS ? - - An example of a large, sparse, positive definite matrix is the matrix -obtained from a finite-difference approximation of the Laplacian operator. -If an explicit representation of such a matrix is available, then the -following code is suggested as a reasonable way of computing solutions: - - - /* A*x == b is the system to be solved */ - SPMAT *A, *LLT; - VEC *x, *b; - int num_steps; - ...... - /* set up A and b */ - ...... - x = m_get(A->m); - LLT = sp_copy(A); - - /* preconditioning using the incomplete Cholesky factorisation */ - spICHfactor(LLT); - - /* now use pre-conditioned conjugate gradients */ - x = iter_spcg(A,LLT,b,1e-7,x,1000,&num_steps); - /* solution computed to give a relative residual of 10^-7 */ - - - If explicitly storing such a matrix takes up too much memory, then if -you can write a routine to perform the calculation of A*x for any given x , -the following code may be more suitable (if slower): - - - VEC *mult_routine(user_def,x,out) - void *user_def; - VEC *x, *out; - { - /* compute out = A*x */ - ...... - return out; - } - - - main() - { - ITER *ip; - VEC *x, *b; - ...... - b = v_get(BIG_DIM); /* right-hand side */ - x = v_get(BIG_DIM); /* solution */ - - /* set up b */ - ...... - ip = iter_get(b->dim, x->dim); - ip->b = v_copy(b,ip->b); - ip->info = NULL; /* if you don't want information - about solution process */ - v_zero(ip->x); /* initial guess is zero */ - iter_Ax(ip,mult_routine,user_def); - iter_cg(ip); - printf("# Solution is:\n"); v_output(ip->x); - ...... - ITER_FREE(ip); /* destroy ip */ - } - - The user_def argument is for a pointer to a user-defined structure -(possibly NULL, if you don't need this) so that you can write a common -function for handling a large number of different circumstances. - - - -8. MORE ADVANCED TOPICS - - Read this if you are interested in using Meschach library as a base for -applications. As an example we show how to implement a new type for 3 -dimensional matrices and incorporate this new type into the Meschach -system. Usually this part of Meschach is transparent to a user. But a more -advanced user can take advantage of these routines. We do not describe -the routines in detail here, but we want to give a rather broad picture of -what can be done. By the system we mainly mean the system of delivering -information on the number of bytes of allocated memory and routines for -deallocating static variables by mem_stat_... routines. - - First we introduce a concept of a list of types. By a list of types we -mean a set of different types with corresponding routines for creating -these types, destroying and resizing them. Each type list has a number. -The list 0 is a list of standard Meschach types such as MAT or VEC. Other -lists can be defined by a user or a application (based on Meschach). The -user can attach his/her own list to the system by the routine -mem_attach_list(). Sometimes it is worth checking if a list number is -already used by another application. It can be done by -mem_is_list_attached(ls_num), which returns TRUE if the number ls_num -is used. And such a list can be removed from the system by -mem_free_list(ls_num) if necessary. - - We describe arguments required by mem_attach_list(). The prototype of -this function is as follow - - int mem_attach_list(int ls_num, int ntypes, char *type_names[], - int (*free_funcs[])(), MEM_ARRAY sum[]); - -where the structure MEM_ARRAY has two members: "bytes" of type long and -"numvar" of type int. The frst argument is the list number. Note that you -cannot overwrite another list. To do this remove first the old list (by -mem_free_list()) or choose another number. The next argument is the number -of types which are on the list. This number cannot be changed during -running a program. The third argument is an array containing the names of -types (these are character strings). The fourth one is an array of -functions deallocating variables of the corresponding type. And the last -argument is the local array where information about the number of bytes of -allocated/deallocated memory (member bytes) and the number of allocated -variables (member numvar) are gathered. The functions which send -information to this array are mem_bytes_list() and mem_numvar_list(). - - -Example: The routines described here are in the file tutadv.c. -Firstly we define some macros and a type for 3 dimensional matrices. - -#include "matrix.h" -#define M3D_LIST 3 /* list number */ -#define TYPE_MAT3D 0 /* the number of a type */ -/* type for 3 dimensional matrices */ -typedef struct { - int l,m,n; /* actual dimensions */ - int max_l, max_m, max_n; /* maximal dimensions */ - Real ***me; /* pointer to matrix elements */ - /* we do not consider segmented memory */ - Real *base, **me2d; /* me and me2d are additional pointers - to base */ -} MAT3D; - - -Now we need two routines: one for allocating memory for 3 dimensional -matrices and the other for deallocating it. It can be useful to have a -routine for resizing 3 dimensional matrices but we do not use it here. -Note the use of mem_bytes_list() and mem_numvar_list() to notify the change -in the number of structures and bytes in use. - -/* function for creating a variable of MAT3D type */ - -MAT3D *m3d_get(l,m,n) -int l,m,n; -{ - MAT3D *mat; - .... - /* alocate memory for structure */ - if ((mat = NEW(MAT3D)) == (MAT3D *)NULL) - error(E_MEM,"m3d_get"); - else if (mem_info_is_on()) { - /* record how many bytes are allocated to structure */ - mem_bytes_list(TYPE_MAT3D,0,sizeof(MAT3D),M3D_LIST); - /* record a new allocated variable */ - mem_numvar_list(TYPE_MAT3D,1,M3D_LIST); - } - .... - /* allocate memory for 3D array */ - if ((mat->base = NEW_A(l*m*n,Real)) == (Real *)NULL) - error(E_MEM,"m3d_get"); - else if (mem_info_is_on()) - mem_bytes_list(TYPE_MAT3D,0,l*m*n*sizeof(Real),M3D_LIST); - .... - return mat; -} - -/* deallocate a variable of type MAT3D */ - -int m3d_free(mat) -MAT3D *mat; -{ - /* do not try to deallocate the NULL pointer */ - if (mat == (MAT3D *)NULL) - return -1; - .... - /* first deallocate base */ - if (mat->base != (Real *)NULL) { - if (mem_info_is_on()) - /* record how many bytes is deallocated */ - mem_bytes_list(TYPE_MAT3D,mat->max_l*mat->max_m*mat->max_n*sizeof(Real), - 0,M3D_LIST); - free((char *)mat->base); - } - .... - /* deallocate MAT3D structure */ - if (mem_info_is_on()) { - mem_bytes_list(TYPE_MAT3D,sizeof(MAT3D),0,M3D_LIST); - mem_numvar_list(TYPE_MAT3D,-1,M3D_LIST); - } - free((char *)mat); - - .... - free((char *)mat); - - return 0; -} - - -We can now create the arrays necessary for mem_attach_list(). Note that -m3d_sum can be static if it is in the same file as main(), where -mem_attach_list is called. Otherwise it must be global. - - -char *m3d_names[] = { - "MAT3D" -}; - -#define M3D_NUM (sizeof(m3d_names)/sizeof(*m3d_names)) - -int (*m3d_free_funcs[M3D_NUM])() = { - m3d_free -} - -static MEM_ARRAY m3d_sum[M3D_NUM]; - - -The last thing is to attach the list to the system. - -void main() -{ - MAT3D *M; - .... - - mem_info_on(TRUE); /* switch memory info on */ - /* attach the new list */ - mem_attach_list(M3D_LIST,M3D_NUM,m3d_names,m3d_free_funcs,m3d_sum); - .... - M = m3d_get(3,4,5); - .... - /* making use of M->me[i][j][k], where i,j,k are non-negative and - i < 3, j < 4, k < 5 */ - .... - mem_info_file(stdout,M3D_LIST); /* info on the number of allocated - bytes of memory for types - on the list M3D_LIST */ - .... - m3d_free(M); /* if M is not necessary */ - .... -} - - -We can now use the function mem_info_file() for getting information about -the number of bytes of allocated memory and number of allocated variables -of type MAT3D; mem_stat_reg_list() for registering variables of this type -and mem_stat_mark() and mem_stat_free_list() for deallocating static -variables of this type. - - - -In the similar way you can create you own list of errors and attach it to -the system. See the functions: - - int err_list_attach(int list_num, int list_len, char **err_ptr, - int warn); /* for attaching a list of errors */ - - int err_is_list_attached(int list_num); /* checking if a list - is attached */ - - extern int err_list_free(int list_num); /* freeing a list of errors */ - -where list_num is the number of the error list, list_len is the number of -errors on the list, err_ptr is the character string explaining the error -and warn can be TRUE if this is only a warning (the program continues to -run) or it can be FALSE if it is an error (the program stops). - -The examples are the standard errors (error list 0) and warnings -(error list 1) which are in the file err.c - - - David Stewart and Zbigniew Leyk, 1993 //GO.SYSIN DD DOC/tutorial.txt mkdir MACHINES mkdir MACHINES/GCC echo MACHINES/GCC/makefile 1>&2 sed >MACHINES/GCC/makefile <<'//GO.SYSIN DD MACHINES/GCC/makefile' 's/^-//' -# -# -# Makefile for Meschach for GNU cc -# -# Copyright (C) David Stewart & Zbigniew Leyk 1993 -# -# $Id: $ -# - -srcdir = . -VPATH = . - -CC = gcc - -DEFS = -DHAVE_CONFIG_H -LIBS = -lm -RANLIB = ranlib - - -CFLAGS = -O6 - - -.c.o: - $(CC) -c $(CFLAGS) $(DEFS) $< - -SHELL = /bin/sh -MES_PAK = mesch12a -TAR = tar -SHAR = stree -u -ZIP = zip -r -l - -############################### - -LIST1 = copy.o err.o matrixio.o memory.o vecop.o matop.o pxop.o \ - submat.o init.o otherio.o machine.o matlab.o ivecop.o version.o \ - meminfo.o memstat.o -LIST2 = lufactor.o bkpfacto.o chfactor.o qrfactor.o solve.o hsehldr.o \ - givens.o update.o norm.o hessen.o symmeig.o schur.o svd.o fft.o \ - mfunc.o bdfactor.o -LIST3 = sparse.o sprow.o sparseio.o spchfctr.o splufctr.o \ - spbkp.o spswap.o iter0.o itersym.o iternsym.o -ZLIST1 = zmachine.o zcopy.o zmatio.o zmemory.o zvecop.o zmatop.o znorm.o \ - zfunc.o -ZLIST2 = zlufctr.o zsolve.o zmatlab.o zhsehldr.o zqrfctr.o \ - zgivens.o zhessen.o zschur.o - -# they are no longer supported -# if you use them add oldpart to all and sparse -OLDLIST = conjgrad.o lanczos.o arnoldi.o - -ALL_LISTS = $(LIST1) $(LIST2) $(LIST3) $(ZLIST1) $(ZLIST2) $(OLDLIST) - - -HLIST = err.h iter.h machine.h matlab.h matrix.h matrix2.h \ - meminfo.h oldnames.h sparse.h sparse2.h \ - zmatrix.h zmatrix2.h - -TORTURE = torture.o sptort.o ztorture.o memtort.o itertort.o \ - mfuntort.o iotort.o - -OTHERS = dmacheps.c extras.c fmacheps.c maxint.c makefile.in \ - README configure configure.in machine.h.in copyright \ - tutorial.c tutadv.c rk4.dat ls.dat makefile - - -# Different configurations -all: part1 part2 part3 zpart1 zpart2 -basic: part1 part2 -sparse: part1 part2 part3 -complex: part1 part2 zpart1 zpart2 - - -HBASE = err.h meminfo.h machine.h matrix.h - -$(LIST1): $(HBASE) -part1: $(LIST1) - ar ru meschach.a $(LIST1); $(RANLIB) meschach.a - -$(LIST2): $(HBASE) matrix2.h -part2: $(LIST2) - ar ru meschach.a $(LIST2); $(RANLIB) - -$(LIST3): $(HBASE) sparse.h sparse2.h -part3: $(LIST3) - ar ru meschach.a $(LIST3); $(RANLIB) meschach.a - -$(ZLIST1): $(HBASDE) zmatrix.h -zpart1: $(ZLIST1) - ar ru meschach.a $(ZLIST1); ranlib meschach.a - -$(ZLIST2): $(HBASE) zmatrix.h zmatrix2.h -zpart2: $(ZLIST2) - ar ru meschach.a $(ZLIST2); ranlib meschach.a - -$(OLDLIST): $(HBASE) sparse.h sparse2.h -oldpart: $(OLDLIST) - ar ru meschach.a $(OLDLIST); ranlib meschach.a - - - -####################################### - -tar: - - /bin/rm -f $(MES_PAK).tar - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(TAR) cvf $(MES_PAK).tar \ - `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) \ - `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC - -# use this only for PC machines -msdos-zip: - - /bin/rm -f $(MES_PAK).zip - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(ZIP) $(MES_PAK).zip \ - `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC - - -fullshar: - - /bin/rm -f $(MES_PAK).shar; - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(SHAR) `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC > $(MES_PAK).shar - -shar: - - /bin/rm -f meschach1.shar meschach2.shar meschach3.shar \ - meschach4.shar oldmeschach.shar meschach0.shar - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(SHAR) `echo $(LIST1) | sed -e 's/\.o/.c/g'` > meschach1.shar - $(SHAR) `echo $(LIST2) | sed -e 's/\.o/.c/g'` > meschach2.shar - $(SHAR) `echo $(LIST3) | sed -e 's/\.o/.c/g'` > meschach3.shar - $(SHAR) `echo $(ZLIST1) | sed -e 's/\.o/.c/g'` \ - `echo $(ZLIST2) | sed -e 's/\.o/.c/g'` > meschach4.shar - $(SHAR) `echo $(OLDLIST) | sed -e 's/\.o/.c/g'` > oldmeschach.shar - $(SHAR) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - $(HLIST) DOC MACHINES > meschach0.shar - - -clean: - /bin/rm -f *.o core asx5213a.mat iotort.dat - -cleanup: - /bin/rm -f *.o core asx5213a.mat iotort.dat *.a - -alltorture: torture sptort ztorture memtort itertort mfuntort iotort - -torture:torture.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o torture torture.o \ - meschach.a $(LIBS) -sptort:sptort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o sptort sptort.o \ - meschach.a $(LIBS) -memtort: memtort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o memtort memtort.o \ - meschach.a $(LIBS) -ztorture:ztorture.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o ztorture ztorture.o \ - meschach.a $(LIBS) -itertort: itertort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o itertort itertort.o \ - meschach.a $(LIBS) - -iotort: iotort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o iotort iotort.o \ - meschach.a $(LIBS) -mfuntort: mfuntort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o mfuntort mfuntort.o \ - meschach.a $(LIBS) -tstmove: tstmove.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o tstmove tstmove.o \ - meschach.a $(LIBS) -tstpxvec: tstpxvec.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o tstpxvec tstpxvec.o \ - meschach.a $(LIBS) - //GO.SYSIN DD MACHINES/GCC/makefile echo MACHINES/GCC/machine.h 1>&2 sed >MACHINES/GCC/machine.h <<'//GO.SYSIN DD MACHINES/GCC/machine.h' 's/^-//' -/* machine.h. Generated automatically by configure. */ -/* Any machine specific stuff goes here */ -/* Add details necessary for your own installation here! */ - -/* This is for use with "configure" -- if you are not using configure - then use machine.van for the "vanilla" version of machine.h */ - -/* Note special macros: ANSI_C (ANSI C syntax) - SEGMENTED (segmented memory machine e.g. MS-DOS) - MALLOCDECL (declared if malloc() etc have - been declared) */ - - -#define ANSI_C 1 -#define NOT_SEGMENTED 1 -/* #undef HAVE_COMPLEX_H */ -#define HAVE_MALLOC_H 1 -#define STDC_HEADERS -#define HAVE_BCOPY 1 -#define HAVE_BZERO 1 -#define CHAR0ISDBL0 1 -#define WORDS_BIGENDIAN 1 -/* #undef U_INT_DEF */ - - -/* for basic or larger versions */ -#define COMPLEX 1 -#define SPARSE 1 - -/* for loop unrolling */ -/* #undef VUNROLL */ -/* #undef MUNROLL */ - -/* for segmented memory */ -#ifndef NOT_SEGMENTED -#define SEGMENTED -#endif - -/* if the system has malloc.h */ -#ifdef HAVE_MALLOC_H -#define MALLOCDECL 1 -#include <malloc.h> -#endif - -/* any compiler should have this header */ -/* if not, change it */ -#include <stdio.h> - - -/* Check for ANSI C memmove and memset */ -#ifdef STDC_HEADERS - -/* standard copy & zero functions */ -#define MEM_COPY(from,to,size) memmove((to),(from),(size)) -#define MEM_ZERO(where,size) memset((where),'\0',(size)) - -#ifndef ANSI_C -#define ANSI_C 1 -#endif - -#endif - -/* standard headers */ -#ifdef ANSI_C -#include <stdlib.h> -#include <stddef.h> -#include <string.h> -#include <float.h> -#endif - - -/* if have bcopy & bzero and no alternatives yet known, use them */ -#ifdef HAVE_BCOPY -#ifndef MEM_COPY -/* nonstandard copy function */ -#define MEM_COPY(from,to,size) bcopy((char *)(from),(char *)(to),(int)(size)) -#endif -#endif - -#ifdef HAVE_BZERO -#ifndef MEM_ZERO -/* nonstandard zero function */ -#define MEM_ZERO(where,size) bzero((char *)(where),(int)(size)) -#endif -#endif - -/* if the system has complex.h */ -#ifdef HAVE_COMPLEX_H -#include <complex.h> -#endif - -/* If prototypes are available & ANSI_C not yet defined, then define it, - but don't include any header files as the proper ANSI C headers - aren't here */ -/* #undef HAVE_PROTOTYPES */ -#ifdef HAVE_PROTOTYPES -#ifndef ANSI_C -#define ANSI_C 1 -#endif -#endif - -/* floating point precision */ - -/* you can choose single, double or long double (if available) precision */ - -#define FLOAT 1 -#define DOUBLE 2 -#define LONG_DOUBLE 3 - -/* #undef REAL_FLT */ -#define REAL_DBL 1 - -/* if nothing is defined, choose double precision */ -#ifndef REAL_DBL -#ifndef REAL_FLT -#define REAL_DBL 1 -#endif -#endif - -/* single precision */ -#ifdef REAL_FLT -#define Real float -#define LongReal float -#define REAL FLOAT -#define LONGREAL FLOAT -#endif - -/* double precision */ -#ifdef REAL_DBL -#define Real double -#define LongReal double -#define REAL DOUBLE -#define LONGREAL DOUBLE -#endif - - -/* machine epsilon or unit roundoff error */ -/* This is correct on most IEEE Real precision systems */ -#ifdef DBL_EPSILON -#if REAL == DOUBLE -#define MACHEPS DBL_EPSILON -#elif REAL == FLOAT -#define MACHEPS FLT_EPSILON -#elif REAL == LONGDOUBLE -#define MACHEPS LDBL_EPSILON -#endif -#endif - -#define F_MACHEPS 1.19209e-07 -#define D_MACHEPS 2.22045e-16 - -#ifndef MACHEPS -#if REAL == DOUBLE -#define MACHEPS D_MACHEPS -#elif REAL == FLOAT -#define MACHEPS F_MACHEPS -#elif REAL == LONGDOUBLE -#define MACHEPS D_MACHEPS -#endif -#endif - -/* #undef M_MACHEPS */ - -/******************** -#ifdef DBL_EPSILON -#define MACHEPS DBL_EPSILON -#endif -#ifdef M_MACHEPS -#ifndef MACHEPS -#define MACHEPS M_MACHEPS -#endif -#endif -********************/ - -#define M_MAX_INT 2147483647 -#ifdef M_MAX_INT -#ifndef MAX_RAND -#define MAX_RAND ((double)(M_MAX_INT)) -#endif -#endif - -/* for non-ANSI systems */ -#ifndef HUGE_VAL -#define HUGE_VAL HUGE -#endif - - -#ifdef ANSI_C -extern int isatty(int); -#endif - //GO.SYSIN DD MACHINES/GCC/machine.h mkdir MACHINES/RS6000 echo MACHINES/RS6000/machine.c 1>&2 sed >MACHINES/RS6000/machine.c <<'//GO.SYSIN DD MACHINES/RS6000/machine.c' 's/^-//' - -/************************************************************************** -** -** Copyright (C) 1993 David E. Stewart & Zbigniew Leyk, all rights reserved. -** -** Meschach Library -** -** This Meschach Library is provided "as is" without any express -** or implied warranty of any kind with respect to this software. -** In particular the authors shall not be liable for any direct, -** indirect, special, incidental or consequential damages arising -** in any way from use of the software. -** -** Everyone is granted permission to copy, modify and redistribute this -** Meschach Library, provided: -** 1. All copies contain this copyright notice. -** 2. All modified copies shall carry a notice stating who -** made the last modification and the date of such modification. -** 3. No charge is made for this software or works derived from it. -** This clause shall not be construed as constraining other software -** distributed on the same medium as this software, nor is a -** distribution fee considered a charge. -** -***************************************************************************/ - -/* - This file contains basic routines which are used by the functions - in matrix.a etc. - These are the routines that should be modified in order to take - full advantage of specialised architectures (pipelining, vector - processors etc). - */ -static char *rcsid = "$Header: /usr/local/home/des/meschach/meschach/RCS/machine.c,v 1.3 1991/08/29 06:42:11 des Exp $"; - -#include "machine.h" - -/* __ip__ -- inner product */ -double __ip__(dp1,dp2,len) -register double *dp1, *dp2; -int len; -{ - register int len4; - register int i; - register double sum0, sum1, sum2, sum3; - - sum0 = sum1 = sum2 = sum3 = 0.0; - - len4 = len / 4; - len = len % 4; - - for ( i = 0; i < len4; i++ ) - { - sum0 += dp1[4*i]*dp2[4*i]; - sum1 += dp1[4*i+1]*dp2[4*i+1]; - sum2 += dp1[4*i+2]*dp2[4*i+2]; - sum3 += dp1[4*i+3]*dp2[4*i+3]; - } - sum0 += sum1 + sum2 + sum3; - dp1 += 4*len4; dp2 += 4*len4; - - for ( i = 0; i < len; i++ ) - sum0 += (*dp1++)*(*dp2++); - - return sum0; -} - -/* __mltadd__ -- scalar multiply and add c.f. v_mltadd() */ -void __mltadd__(dp1,dp2,s,len) -register double *dp1, *dp2, s; -register int len; -{ - register int i, len4; - - len4 = len / 4; - len = len % 4; - for ( i = 0; i < len4; i++ ) - { - dp1[4*i] += s*dp2[4*i]; - dp1[4*i+1] += s*dp2[4*i+1]; - dp1[4*i+2] += s*dp2[4*i+2]; - dp1[4*i+3] += s*dp2[4*i+3]; - } - dp1 += 4*len4; dp2 += 4*len4; - - for ( i = 0; i < len; i++ ) - (*dp1++) += s*(*dp2++); -} - -/* __smlt__ scalar multiply array c.f. sv_mlt() */ -void __smlt__(dp,s,out,len) -register double *dp, s, *out; -register int len; -{ - register int i; - for ( i = 0; i < len; i++ ) - (*out++) = s*(*dp++); -} - -/* __add__ -- add arrays c.f. v_add() */ -void __add__(dp1,dp2,out,len) -register double *dp1, *dp2, *out; -register int len; -{ - register int i; - for ( i = 0; i < len; i++ ) - (*out++) = (*dp1++) + (*dp2++); -} - -/* __sub__ -- subtract arrays c.f. v_sub() */ -void __sub__(dp1,dp2,out,len) -register double *dp1, *dp2, *out; -register int len; -{ - register int i; - for ( i = 0; i < len; i++ ) - (*out++) = (*dp1++) - (*dp2++); -} - -/* __zero__ -- zeros an array of double precision numbers */ -void __zero__(dp,len) -register double *dp; -register int len; -{ - /* if a double precision zero is equivalent to a string of nulls */ - MEM_ZERO((char *)dp,len*sizeof(double)); - /* else, need to zero the array entry by entry */ - /************************************************* - while ( len-- ) - *dp++ = 0.0; - *************************************************/ -} - -/*********************************************************************** - ****** Faster versions ******** - ***********************************************************************/ - -/* __ip4__ -- compute 4 inner products in one go */ -void __ip4__(v0,v1,v2,v3,w,out,len) -double *v0, *v1, *v2, *v3, *w; -double out[4]; -int len; -{ - register int i, len2; - register double sum00, sum10, sum20, sum30, w_val0; - register double sum01, sum11, sum21, sum31, w_val1; - - len2 = len / 2; - len = len % 2; - sum00 = sum10 = sum20 = sum30 = 0.0; - sum01 = sum11 = sum21 = sum31 = 0.0; - for ( i = 0; i < len2; i++ ) - { - w_val0 = w[2*i]; - w_val1 = w[2*i+1]; - sum00 += v0[2*i] *w_val0; - sum01 += v0[2*i+1]*w_val1; - sum10 += v1[2*i] *w_val0; - sum11 += v1[2*i+1]*w_val1; - sum20 += v2[2*i] *w_val0; - sum21 += v2[2*i+1]*w_val1; - sum30 += v3[2*i] *w_val0; - sum31 += v3[2*i+1]*w_val1; - } - w += 2*len2; - v0 += 2*len2; - v1 += 2*len2; - v2 += 2*len2; - v3 += 2*len2; - for ( i = 0; i < len; i++ ) - { - w_val0 = w[i]; - sum00 += v0[i]*w_val0; - sum10 += v1[i]*w_val0; - sum20 += v2[i]*w_val0; - sum30 += v3[i]*w_val0; - } - out[0] = sum00 + sum01; - out[1] = sum10 + sum11; - out[2] = sum20 + sum21; - out[3] = sum30 + sum31; -} - -/* __lc4__ -- linear combinations: w <- w+a[0]*v0+ ... + a[3]*v3 */ -void __lc4__(v0,v1,v2,v3,w,a,len) -double *v0, *v1, *v2, *v3, *w; -double a[4]; -int len; -{ - register int i, len2; - register double a0, a1, a2, a3, tmp0, tmp1; - - len2 = len / 2; - len = len % 2; - - a0 = a[0]; a1 = a[1]; - a2 = a[2]; a3 = a[3]; - for ( i = 0; i < len2; i++ ) - { - tmp0 = w[2*i] + a0*v0[2*i]; - tmp1 = w[2*i+1] + a0*v0[2*i+1]; - tmp0 += a1*v1[2*i]; - tmp1 += a1*v1[2*i+1]; - tmp0 += a2*v2[2*i]; - tmp1 += a2*v2[2*i+1]; - tmp0 += a3*v3[2*i]; - tmp1 += a3*v3[2*i+1]; - w[2*i] = tmp0; - w[2*i+1] = tmp1; - } - w += 2*len2; - v0 += 2*len2; - v1 += 2*len2; - v2 += 2*len2; - v3 += 2*len2; - for ( i = 0; i < len; i++ ) - w[i] += a0*v0[i] + a1*v1[i] + a2*v2[i] + a3*v3[i]; -} - -/* __ma4__ -- multiply and add with 4 vectors: vi <- vi + ai*w */ -void __ma4__(v0,v1,v2,v3,w,a,len) -double *v0, *v1, *v2, *v3, *w; -double a[4]; -int len; -{ - register int i; - register double a0, a1, a2, a3, w0, w1, w2, w3; - - a0 = a[0]; a1 = a[1]; - a2 = a[2]; a3 = a[3]; - for ( i = 0; i < len; i++ ) - { - w0 = w[i]; - v0[i] += a0*w0; - v1[i] += a1*w0; - v2[i] += a2*w0; - v3[i] += a3*w0; - } -} //GO.SYSIN DD MACHINES/RS6000/machine.c echo MACHINES/RS6000/machine.h 1>&2 sed >MACHINES/RS6000/machine.h <<'//GO.SYSIN DD MACHINES/RS6000/machine.h' 's/^-//' - -/* Note special macros: ANSI_C (ANSI C syntax) - SEGMENTED (segmented memory machine e.g. MS-DOS) - MALLOCDECL (declared if malloc() etc have - been declared) */ - -#define ANSI_C 1 - -/* #undef MALLOCDECL */ -#define NOT_SEGMENTED 1 -/* #undef HAVE_COMPLEX_H */ -#define HAVE_MALLOC_H 1 -#define STDC_HEADERS 1 -#define HAVE_BCOPY 1 -#define HAVE_BZERO 1 -#define CHAR0ISDBL0 1 -#define WORDS_BIGENDIAN 1 -#define U_INT_DEF 1 - - -/* for basic or larger versions */ -#define COMPLEX 1 -#define SPARSE 1 - -/* for loop unrolling */ -/* #undef VUNROLL */ -/* #undef MUNROLL */ - -/* for segmented memory */ -#ifndef NOT_SEGMENTED -#define SEGMENTED -#endif - -/* if the system has malloc.h */ -#ifdef HAVE_MALLOC_H -#define MALLOCDECL 1 -#include <malloc.h> -#endif - -/* any compiler should have this header */ -/* if not, change it */ -#include <stdio.h> - - -/* Check for ANSI C memmove and memset */ -#ifdef STDC_HEADERS - -/* standard copy & zero functions */ -#define MEM_COPY(from,to,size) memmove((to),(from),(size)) -#define MEM_ZERO(where,size) memset((where),'\0',(size)) - -#ifndef ANSI_C -#define ANSI_C 1 -#endif - -#endif - -/* standard headers */ -#ifdef ANSI_C -#include <stdlib.h> -#include <stddef.h> -#include <string.h> -#include <float.h> -#endif - - -/* if have bcopy & bzero and no alternatives yet known, use them */ -#ifdef HAVE_BCOPY -#ifndef MEM_COPY -/* nonstandard copy function */ -#define MEM_COPY(from,to,size) bcopy((char *)(from),(char *)(to),(int)(size)) -#endif -#endif - -#ifdef HAVE_BZERO -#ifndef MEM_ZERO -/* nonstandard zero function */ -#define MEM_ZERO(where,size) bzero((char *)(where),(int)(size)) -#endif -#endif - -/* if the system has complex.h */ -#ifdef HAVE_COMPLEX_H -#include <complex.h> -#endif - -/* If prototypes are available & ANSI_C not yet defined, then define it, - but don't include any header files as the proper ANSI C headers - aren't here */ -#define HAVE_PROTOTYPES 1 -#ifdef HAVE_PROTOTYPES -#ifndef ANSI_C -#define ANSI_C 1 -#endif -#endif - -/* floating point precision */ - -/* you can choose single, double or long double (if available) precision */ - -#define FLOAT 1 -#define DOUBLE 2 -#define LONG_DOUBLE 3 - -/* #undef REAL_FLT */ -/* #undef REAL_DBL */ - -/* if nothing is defined, choose double precision */ -#ifndef REAL_DBL -#ifndef REAL_FLT -#define REAL_DBL 1 -#endif -#endif - -/* single precision */ -#ifdef REAL_FLT -#define Real float -#define LongReal float -#define REAL FLOAT -#define LONGREAL FLOAT -#endif - -/* double precision */ -#ifdef REAL_DBL -#define Real double -#define LongReal double -#define REAL DOUBLE -#define LONGREAL DOUBLE -#endif - - -/* machine epsilon or unit roundoff error */ -/* This is correct on most IEEE Real precision systems */ -#ifdef DBL_EPSILON -#if REAL == DOUBLE -#define MACHEPS DBL_EPSILON -#elif REAL == FLOAT -#define MACHEPS FLT_EPSILON -#elif REAL == LONGDOUBLE -#define MACHEPS LDBL_EPSILON -#endif -#endif - -#define F_MACHEPS 1.19209e-07 -#define D_MACHEPS 2.22045e-16 - -#ifndef MACHEPS -#if REAL == DOUBLE -#define MACHEPS D_MACHEPS -#elif REAL == FLOAT -#define MACHEPS F_MACHEPS -#elif REAL == LONGDOUBLE -#define MACHEPS D_MACHEPS -#endif -#endif - -/* #undef M_MACHEPS */ - -/******************** -#ifdef DBL_EPSILON -#define MACHEPS DBL_EPSILON -#endif -#ifdef M_MACHEPS -#ifndef MACHEPS -#define MACHEPS M_MACHEPS -#endif -#endif -********************/ - -#define M_MAX_INT 2147483647 -#ifdef M_MAX_INT -#ifndef MAX_RAND -#define MAX_RAND ((double)(M_MAX_INT)) -#endif -#endif - -/* for non-ANSI systems */ -#ifndef HUGE_VAL -#define HUGE_VAL HUGE -#endif - - -#ifdef ANSI_C -extern int isatty(int); -#endif - //GO.SYSIN DD MACHINES/RS6000/machine.h echo MACHINES/RS6000/makefile 1>&2 sed >MACHINES/RS6000/makefile <<'//GO.SYSIN DD MACHINES/RS6000/makefile' 's/^-//' -# Generated automatically from makefile.in by configure. -# -# Makefile for Meschach via autoconf -# -# Copyright (C) David Stewart & Zbigniew Leyk 1993 -# -# $Id: $ -# - -srcdir = . -VPATH = . - -CC = cc - -DEFS = -DHAVE_CONFIG_H -LIBS = -lm -RANLIB = ranlib - - -CFLAGS = -O - - -.c.o: - $(CC) -c $(CFLAGS) $(DEFS) $< - -SHELL = /bin/sh -MES_PAK = mesch12a -TAR = tar -SHAR = stree -u -ZIP = zip -r -l -FLIST = FILELIST - -############################### - -LIST1 = copy.o err.o matrixio.o memory.o vecop.o matop.o pxop.o \ - submat.o init.o otherio.o machine.o matlab.o ivecop.o version.o \ - meminfo.o memstat.o -LIST2 = lufactor.o bkpfacto.o chfactor.o qrfactor.o solve.o hsehldr.o \ - givens.o update.o norm.o hessen.o symmeig.o schur.o svd.o fft.o \ - mfunc.o bdfactor.o -LIST3 = sparse.o sprow.o sparseio.o spchfctr.o splufctr.o \ - spbkp.o spswap.o iter0.o itersym.o iternsym.o -ZLIST1 = zmachine.o zcopy.o zmatio.o zmemory.o zvecop.o zmatop.o znorm.o \ - zfunc.o -ZLIST2 = zlufctr.o zsolve.o zmatlab.o zhsehldr.o zqrfctr.o \ - zgivens.o zhessen.o zschur.o - -# they are no longer supported -# if you use them add oldpart to all and sparse -OLDLIST = conjgrad.o lanczos.o arnoldi.o - -ALL_LISTS = $(LIST1) $(LIST2) $(LIST3) $(ZLIST1) $(ZLIST2) $(OLDLIST) - -HBASE = err.h meminfo.h machine.h matrix.h - -HLIST = $(HBASE) iter.h matlab.h matrix2.h oldnames.h sparse.h \ - sparse2.h zmatrix.h zmatrix2.h - -TORTURE = torture.o sptort.o ztorture.o memtort.o itertort.o \ - mfuntort.o iotort.o - -OTHERS = dmacheps.c extras.c fmacheps.c maxint.c makefile.in \ - README configure configure.in machine.h.in copyright \ - tutorial.c tutadv.c rk4.dat ls.dat makefile $(FLIST) - - -# Different configurations -all: part1 part2 part3 zpart1 zpart2 -basic: part1 part2 -sparse: part1 part2 part3 -complex: part1 part2 zpart1 zpart2 - - -$(LIST1): $(HBASE) -part1: $(LIST1) - ar ru meschach.a $(LIST1); $(RANLIB) meschach.a - -$(LIST2): $(HBASE) matrix2.h -part2: $(LIST2) - ar ru meschach.a $(LIST2); $(RANLIB) meschach.a -schur.o: schur.c $(HBASE) matrix2.h - cc -c $(DEFS) schur.c - -$(LIST3): $(HBASE) sparse.h sparse2.h -part3: $(LIST3) - ar ru meschach.a $(LIST3); $(RANLIB) meschach.a - -$(ZLIST1): $(HBASDE) zmatrix.h -zpart1: $(ZLIST1) - ar ru meschach.a $(ZLIST1); ranlib meschach.a - -$(ZLIST2): $(HBASE) zmatrix.h zmatrix2.h -zpart2: $(ZLIST2) - ar ru meschach.a $(ZLIST2); ranlib meschach.a - -$(OLDLIST): $(HBASE) sparse.h sparse2.h -oldpart: $(OLDLIST) - ar ru meschach.a $(OLDLIST); ranlib meschach.a - - - -####################################### - -tar: - - /bin/rm -f $(MES_PAK).tar - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(TAR) cvf $(MES_PAK).tar \ - `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) \ - `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC - -# use this only for PC machines -msdos-zip: - - /bin/rm -f $(MES_PAK).zip - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(ZIP) $(MES_PAK).zip \ - `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC - - -fullshar: - - /bin/rm -f $(MES_PAK).shar; - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(SHAR) `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC > $(MES_PAK).shar - -shar: - - /bin/rm -f meschach1.shar meschach2.shar meschach3.shar \ - meschach4.shar oldmeschach.shar meschach0.shar - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(SHAR) `echo $(LIST1) | sed -e 's/\.o/.c/g'` > meschach1.shar - $(SHAR) `echo $(LIST2) | sed -e 's/\.o/.c/g'` > meschach2.shar - $(SHAR) `echo $(LIST3) | sed -e 's/\.o/.c/g'` > meschach3.shar - $(SHAR) `echo $(ZLIST1) | sed -e 's/\.o/.c/g'` \ - `echo $(ZLIST2) | sed -e 's/\.o/.c/g'` > meschach4.shar - $(SHAR) `echo $(OLDLIST) | sed -e 's/\.o/.c/g'` > oldmeschach.shar - $(SHAR) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - $(HLIST) DOC MACHINES > meschach0.shar - -list: - /bin/rm -f $(FLIST) - ls -lR `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) MACHINES DOC \ - |awk '/^$$/ {print};/^[-d]/ {printf("%s %s %10d %s %s %s %s\n", \ - $$1,$$2,$$5,$$6,$$7,$$8,$$9)}; /^[^-d]/ {print}' \ - > $(FLIST) - - - -clean: - /bin/rm -f *.o core asx5213a.mat iotort.dat - -cleanup: - /bin/rm -f *.o core asx5213a.mat iotort.dat *.a - -alltorture: torture sptort ztorture memtort itertort mfuntort iotort - -torture:torture.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o torture torture.o \ - meschach.a $(LIBS) -sptort:sptort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o sptort sptort.o \ - meschach.a $(LIBS) -memtort: memtort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o memtort memtort.o \ - meschach.a $(LIBS) -ztorture:ztorture.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o ztorture ztorture.o \ - meschach.a $(LIBS) -itertort: itertort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o itertort itertort.o \ - meschach.a $(LIBS) - -iotort: iotort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o iotort iotort.o \ - meschach.a $(LIBS) -mfuntort: mfuntort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o mfuntort mfuntort.o \ - meschach.a $(LIBS) -tstmove: tstmove.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o tstmove tstmove.o \ - meschach.a $(LIBS) -tstpxvec: tstpxvec.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o tstpxvec tstpxvec.o \ - meschach.a $(LIBS) - //GO.SYSIN DD MACHINES/RS6000/makefile mkdir MACHINES/SPARC echo MACHINES/SPARC/machine.h 1>&2 sed >MACHINES/SPARC/machine.h <<'//GO.SYSIN DD MACHINES/SPARC/machine.h' 's/^-//' - -/* Note special macros: ANSI_C (ANSI C syntax) - SEGMENTED (segmented memory machine e.g. MS-DOS) - MALLOCDECL (declared if malloc() etc have - been declared) */ - -#define const - -/* #undef MALLOCDECL */ -#define NOT_SEGMENTED 1 -/* #undef HAVE_COMPLEX_H */ -#define HAVE_MALLOC_H 1 -/* #undef STDC_HEADERS */ -#define HAVE_BCOPY 1 -#define HAVE_BZERO 1 -#define CHAR0ISDBL0 1 -#define WORDS_BIGENDIAN 1 -/* #undef U_INT_DEF */ -#define VARARGS 1 - - -/* for basic or larger versions */ -#define COMPLEX 1 -#define SPARSE 1 - -/* for loop unrolling */ -/* #undef VUNROLL */ -/* #undef MUNROLL */ - -/* for segmented memory */ -#ifndef NOT_SEGMENTED -#define SEGMENTED -#endif - -/* if the system has malloc.h */ -#ifdef HAVE_MALLOC_H -#define MALLOCDECL 1 -#include <malloc.h> -#endif - -/* any compiler should have this header */ -/* if not, change it */ -#include <stdio.h> - - -/* Check for ANSI C memmove and memset */ -#ifdef STDC_HEADERS - -/* standard copy & zero functions */ -#define MEM_COPY(from,to,size) memmove((to),(from),(size)) -#define MEM_ZERO(where,size) memset((where),'\0',(size)) - -#ifndef ANSI_C -#define ANSI_C 1 -#endif - -#endif - -/* standard headers */ -#ifdef ANSI_C -#include <stdlib.h> -#include <stddef.h> -#include <string.h> -#include <float.h> -#endif - - -/* if have bcopy & bzero and no alternatives yet known, use them */ -#ifdef HAVE_BCOPY -#ifndef MEM_COPY -/* nonstandard copy function */ -#define MEM_COPY(from,to,size) bcopy((char *)(from),(char *)(to),(int)(size)) -#endif -#endif - -#ifdef HAVE_BZERO -#ifndef MEM_ZERO -/* nonstandard zero function */ -#define MEM_ZERO(where,size) bzero((char *)(where),(int)(size)) -#endif -#endif - -/* if the system has complex.h */ -#ifdef HAVE_COMPLEX_H -#include <complex.h> -#endif - -/* If prototypes are available & ANSI_C not yet defined, then define it, - but don't include any header files as the proper ANSI C headers - aren't here */ -/* #undef HAVE_PROTOTYPES */ -#ifdef HAVE_PROTOTYPES -#ifndef ANSI_C -#define ANSI_C 1 -#endif -#endif - -/* floating point precision */ - -/* you can choose single, double or long double (if available) precision */ - -#define FLOAT 1 -#define DOUBLE 2 -#define LONG_DOUBLE 3 - -/* #undef REAL_FLT */ -#define REAL_DBL 1 - -/* if nothing is defined, choose double precision */ -#ifndef REAL_DBL -#ifndef REAL_FLT -#define REAL_DBL 1 -#endif -#endif - -/* single precision */ -#ifdef REAL_FLT -#define Real float -#define LongReal float -#define REAL FLOAT -#define LONGREAL FLOAT -#endif - -/* double precision */ -#ifdef REAL_DBL -#define Real double -#define LongReal double -#define REAL DOUBLE -#define LONGREAL DOUBLE -#endif - - -/* machine epsilon or unit roundoff error */ -/* This is correct on most IEEE Real precision systems */ -#ifdef DBL_EPSILON -#if REAL == DOUBLE -#define MACHEPS DBL_EPSILON -#elif REAL == FLOAT -#define MACHEPS FLT_EPSILON -#elif REAL == LONGDOUBLE -#define MACHEPS LDBL_EPSILON -#endif -#endif - -#define F_MACHEPS 1.19209e-07 -#define D_MACHEPS 2.22045e-16 - -#ifndef MACHEPS -#if REAL == DOUBLE -#define MACHEPS D_MACHEPS -#elif REAL == FLOAT -#define MACHEPS F_MACHEPS -#elif REAL == LONGDOUBLE -#define MACHEPS D_MACHEPS -#endif -#endif - -/* #undef M_MACHEPS */ - -/******************** -#ifdef DBL_EPSILON -#define MACHEPS DBL_EPSILON -#endif -#ifdef M_MACHEPS -#ifndef MACHEPS -#define MACHEPS M_MACHEPS -#endif -#endif -********************/ - -#define M_MAX_INT 2147483647 -#ifdef M_MAX_INT -#ifndef MAX_RAND -#define MAX_RAND ((double)(M_MAX_INT)) -#endif -#endif - -/* for non-ANSI systems */ -#ifndef HUGE_VAL -#define HUGE_VAL HUGE -#endif - - -#ifdef ANSI_C -extern int isatty(int); -#endif - //GO.SYSIN DD MACHINES/SPARC/machine.h echo MACHINES/SPARC/makefile 1>&2 sed >MACHINES/SPARC/makefile <<'//GO.SYSIN DD MACHINES/SPARC/makefile' 's/^-//' -# # -# Makefile for Meschach for SUN SPARC cc -# -# Copyright (C) David Stewart & Zbigniew Leyk 1993 -# -# $Id: $ -# - -srcdir = . -VPATH = . - -CC = cc - -DEFS = -DHAVE_CONFIG_H -LIBS = -lm -RANLIB = ranlib - - -CFLAGS = -O - - -.c.o: - $(CC) -c $(CFLAGS) $(DEFS) $< - -SHELL = /bin/sh -MES_PAK = mesch12a -TAR = tar -SHAR = stree -u -ZIP = zip -r -l - -############################### - -LIST1 = copy.o err.o matrixio.o memory.o vecop.o matop.o pxop.o \ - submat.o init.o otherio.o machine.o matlab.o ivecop.o version.o \ - meminfo.o memstat.o -LIST2 = lufactor.o bkpfacto.o chfactor.o qrfactor.o solve.o hsehldr.o \ - givens.o update.o norm.o hessen.o symmeig.o schur.o svd.o fft.o \ - mfunc.o bdfactor.o -LIST3 = sparse.o sprow.o sparseio.o spchfctr.o splufctr.o \ - spbkp.o spswap.o iter0.o itersym.o iternsym.o -ZLIST1 = zmachine.o zcopy.o zmatio.o zmemory.o zvecop.o zmatop.o znorm.o \ - zfunc.o -ZLIST2 = zlufctr.o zsolve.o zmatlab.o zhsehldr.o zqrfctr.o \ - zgivens.o zhessen.o zschur.o - -# they are no longer supported -# if you use them add oldpart to all and sparse -OLDLIST = conjgrad.o lanczos.o arnoldi.o - -ALL_LISTS = $(LIST1) $(LIST2) $(LIST3) $(ZLIST1) $(ZLIST2) $(OLDLIST) - - -HLIST = err.h iter.h machine.h matlab.h matrix.h matrix2.h \ - meminfo.h oldnames.h sparse.h sparse2.h \ - zmatrix.h zmatrix2.h - -TORTURE = torture.o sptort.o ztorture.o memtort.o itertort.o \ - mfuntort.o iotort.o - -OTHERS = dmacheps.c extras.c fmacheps.c maxint.c makefile.in \ - README configure configure.in machine.h.in copyright \ - tutorial.c tutadv.c rk4.dat ls.dat makefile - - -# Different configurations -all: part1 part2 part3 zpart1 zpart2 -basic: part1 part2 -sparse: part1 part2 part3 -complex: part1 part2 zpart1 zpart2 - - -HBASE = err.h meminfo.h machine.h matrix.h - -$(LIST1): $(HBASE) -part1: $(LIST1) - ar ru meschach.a $(LIST1); $(RANLIB) meschach.a - -$(LIST2): $(HBASE) matrix2.h -part2: $(LIST2) - ar ru meschach.a $(LIST2); $(RANLIB) - -$(LIST3): $(HBASE) sparse.h sparse2.h -part3: $(LIST3) - ar ru meschach.a $(LIST3); $(RANLIB) meschach.a - -$(ZLIST1): $(HBASDE) zmatrix.h -zpart1: $(ZLIST1) - ar ru meschach.a $(ZLIST1); ranlib meschach.a - -$(ZLIST2): $(HBASE) zmatrix.h zmatrix2.h -zpart2: $(ZLIST2) - ar ru meschach.a $(ZLIST2); ranlib meschach.a - -$(OLDLIST): $(HBASE) sparse.h sparse2.h -oldpart: $(OLDLIST) - ar ru meschach.a $(OLDLIST); ranlib meschach.a - - - -####################################### - -tar: - - /bin/rm -f $(MES_PAK).tar - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(TAR) cvf $(MES_PAK).tar \ - `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) \ - `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC - -# use this only for PC machines -msdos-zip: - - /bin/rm -f $(MES_PAK).zip - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(ZIP) $(MES_PAK).zip \ - `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC - - -fullshar: - - /bin/rm -f $(MES_PAK).shar; - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(SHAR) `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC > $(MES_PAK).shar - -shar: - - /bin/rm -f meschach1.shar meschach2.shar meschach3.shar \ - meschach4.shar oldmeschach.shar meschach0.shar - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(SHAR) `echo $(LIST1) | sed -e 's/\.o/.c/g'` > meschach1.shar - $(SHAR) `echo $(LIST2) | sed -e 's/\.o/.c/g'` > meschach2.shar - $(SHAR) `echo $(LIST3) | sed -e 's/\.o/.c/g'` > meschach3.shar - $(SHAR) `echo $(ZLIST1) | sed -e 's/\.o/.c/g'` \ - `echo $(ZLIST2) | sed -e 's/\.o/.c/g'` > meschach4.shar - $(SHAR) `echo $(OLDLIST) | sed -e 's/\.o/.c/g'` > oldmeschach.shar - $(SHAR) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - $(HLIST) DOC MACHINES > meschach0.shar - - -clean: - /bin/rm -f *.o core asx5213a.mat iotort.dat - -cleanup: - /bin/rm -f *.o core asx5213a.mat iotort.dat *.a - -alltorture: torture sptort ztorture memtort itertort mfuntort iotort - -torture:torture.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o torture torture.o \ - meschach.a $(LIBS) -sptort:sptort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o sptort sptort.o \ - meschach.a $(LIBS) -memtort: memtort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o memtort memtort.o \ - meschach.a $(LIBS) -ztorture:ztorture.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o ztorture ztorture.o \ - meschach.a $(LIBS) -itertort: itertort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o itertort itertort.o \ - meschach.a $(LIBS) - -iotort: iotort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o iotort iotort.o \ - meschach.a $(LIBS) -mfuntort: mfuntort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o mfuntort mfuntort.o \ - meschach.a $(LIBS) -tstmove: tstmove.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o tstmove tstmove.o \ - meschach.a $(LIBS) -tstpxvec: tstpxvec.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o tstpxvec tstpxvec.o \ - meschach.a $(LIBS) - //GO.SYSIN DD MACHINES/SPARC/makefile mkdir MACHINES/Linux echo MACHINES/Linux/makefile 1>&2 sed >MACHINES/Linux/makefile <<'//GO.SYSIN DD MACHINES/Linux/makefile' 's/^-//' -# Generated automatically from makefile.in by configure. -# -# Makefile for Meschach via autoconf -# -# Copyright (C) David Stewart & Zbigniew Leyk 1993 -# -# $Id: $ -# - -srcdir = . -VPATH = . - -CC = cc - -DEFS = -DHAVE_CONFIG_H -LIBS = -lm -RANLIB = ranlib - - -CFLAGS = -O - - -.c.o: - $(CC) -c $(CFLAGS) $(DEFS) $< - -SHELL = /bin/sh -MES_PAK = mesch12a -TAR = tar -SHAR = stree -u -ZIP = zip -r -l -FLIST = FILELIST - -############################### - -LIST1 = copy.o err.o matrixio.o memory.o vecop.o matop.o pxop.o \ - submat.o init.o otherio.o machine.o matlab.o ivecop.o version.o \ - meminfo.o memstat.o -LIST2 = lufactor.o bkpfacto.o chfactor.o qrfactor.o solve.o hsehldr.o \ - givens.o update.o norm.o hessen.o symmeig.o schur.o svd.o fft.o \ - mfunc.o bdfactor.o -LIST3 = sparse.o sprow.o sparseio.o spchfctr.o splufctr.o \ - spbkp.o spswap.o iter0.o itersym.o iternsym.o -ZLIST1 = zmachine.o zcopy.o zmatio.o zmemory.o zvecop.o zmatop.o znorm.o \ - zfunc.o -ZLIST2 = zlufctr.o zsolve.o zmatlab.o zhsehldr.o zqrfctr.o \ - zgivens.o zhessen.o zschur.o - -# they are no longer supported -# if you use them add oldpart to all and sparse -OLDLIST = conjgrad.o lanczos.o arnoldi.o - -ALL_LISTS = $(LIST1) $(LIST2) $(LIST3) $(ZLIST1) $(ZLIST2) $(OLDLIST) - -HBASE = err.h meminfo.h machine.h matrix.h - -HLIST = $(HBASE) iter.h matlab.h matrix2.h oldnames.h sparse.h \ - sparse2.h zmatrix.h zmatrix2.h - -TORTURE = torture.o sptort.o ztorture.o memtort.o itertort.o \ - mfuntort.o iotort.o - -OTHERS = dmacheps.c extras.c fmacheps.c maxint.c makefile.in \ - README configure configure.in machine.h.in copyright \ - tutorial.c tutadv.c rk4.dat ls.dat makefile $(FLIST) - - -# Different configurations -all: part1 part2 part3 zpart1 zpart2 -basic: part1 part2 -sparse: part1 part2 part3 -complex: part1 part2 zpart1 zpart2 - - -$(LIST1): $(HBASE) -part1: $(LIST1) - ar ru meschach.a $(LIST1); $(RANLIB) meschach.a - -$(LIST2): $(HBASE) matrix2.h -part2: $(LIST2) - ar ru meschach.a $(LIST2); $(RANLIB) meschach.a - -$(LIST3): $(HBASE) sparse.h sparse2.h -part3: $(LIST3) - ar ru meschach.a $(LIST3); $(RANLIB) meschach.a - -$(ZLIST1): $(HBASDE) zmatrix.h -zpart1: $(ZLIST1) - ar ru meschach.a $(ZLIST1); ranlib meschach.a - -$(ZLIST2): $(HBASE) zmatrix.h zmatrix2.h -zpart2: $(ZLIST2) - ar ru meschach.a $(ZLIST2); ranlib meschach.a - -$(OLDLIST): $(HBASE) sparse.h sparse2.h -oldpart: $(OLDLIST) - ar ru meschach.a $(OLDLIST); ranlib meschach.a - - - -####################################### - -tar: - - /bin/rm -f $(MES_PAK).tar - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(TAR) cvf $(MES_PAK).tar \ - `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) \ - `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC - -# use this only for PC machines -msdos-zip: - - /bin/rm -f $(MES_PAK).zip - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(ZIP) $(MES_PAK).zip \ - `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC - - -fullshar: - - /bin/rm -f $(MES_PAK).shar; - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(SHAR) `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - MACHINES DOC > $(MES_PAK).shar - -shar: - - /bin/rm -f meschach1.shar meschach2.shar meschach3.shar \ - meschach4.shar oldmeschach.shar meschach0.shar - chmod 644 `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - $(OTHERS) $(HLIST) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` - chmod 755 configure - $(MAKE) list - $(SHAR) `echo $(LIST1) | sed -e 's/\.o/.c/g'` > meschach1.shar - $(SHAR) `echo $(LIST2) | sed -e 's/\.o/.c/g'` > meschach2.shar - $(SHAR) `echo $(LIST3) | sed -e 's/\.o/.c/g'` > meschach3.shar - $(SHAR) `echo $(ZLIST1) | sed -e 's/\.o/.c/g'` \ - `echo $(ZLIST2) | sed -e 's/\.o/.c/g'` > meschach4.shar - $(SHAR) `echo $(OLDLIST) | sed -e 's/\.o/.c/g'` > oldmeschach.shar - $(SHAR) $(OTHERS) `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - $(HLIST) DOC MACHINES > meschach0.shar - -list: - /bin/rm -f $(FLIST) - ls -lR `echo $(ALL_LISTS) | sed -e 's/\.o/.c/g'` \ - `echo $(TORTURE) | sed -e 's/\.o/.c/g'` \ - $(HLIST) $(OTHERS) MACHINES DOC \ - |awk '/^$$/ {print};/^[-d]/ {printf("%s %s %10d %s %s %s %s\n", \ - $$1,$$2,$$5,$$6,$$7,$$8,$$9)}; /^[^-d]/ {print}' \ - > $(FLIST) - - - -clean: - /bin/rm -f *.o core asx5213a.mat iotort.dat - -cleanup: - /bin/rm -f *.o core asx5213a.mat iotort.dat *.a - -alltorture: torture sptort ztorture memtort itertort mfuntort iotort - -torture:torture.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o torture torture.o \ - meschach.a $(LIBS) -sptort:sptort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o sptort sptort.o \ - meschach.a $(LIBS) -memtort: memtort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o memtort memtort.o \ - meschach.a $(LIBS) -ztorture:ztorture.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o ztorture ztorture.o \ - meschach.a $(LIBS) -itertort: itertort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o itertort itertort.o \ - meschach.a $(LIBS) - -iotort: iotort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o iotort iotort.o \ - meschach.a $(LIBS) -mfuntort: mfuntort.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o mfuntort mfuntort.o \ - meschach.a $(LIBS) -tstmove: tstmove.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o tstmove tstmove.o \ - meschach.a $(LIBS) -tstpxvec: tstpxvec.o meschach.a - $(CC) $(CFLAGS) $(DEFS) -o tstpxvec tstpxvec.o \ - meschach.a $(LIBS) - //GO.SYSIN DD MACHINES/Linux/makefile echo MACHINES/Linux/machine.h 1>&2 sed >MACHINES/Linux/machine.h <<'//GO.SYSIN DD MACHINES/Linux/machine.h' 's/^-//' -/* machine.h. Generated automatically by configure. */ -/* Any machine specific stuff goes here */ -/* Add details necessary for your own installation here! */ - -/* This is for use with "configure" -- if you are not using configure - then use machine.van for the "vanilla" version of machine.h */ - -/* Note special macros: ANSI_C (ANSI C syntax) - SEGMENTED (segmented memory machine e.g. MS-DOS) - MALLOCDECL (declared if malloc() etc have - been declared) */ - -/* #undef const */ - -/* #undef MALLOCDECL */ -#define NOT_SEGMENTED 1 -/* #undef HAVE_COMPLEX_H */ -#define HAVE_MALLOC_H 1 -#define STDC_HEADERS 1 -#define HAVE_BCOPY 1 -#define HAVE_BZERO 1 -#define CHAR0ISDBL0 1 -/* #undef WORDS_BIGENDIAN */ -#define U_INT_DEF 1 -#define VARARGS 1 - - -/* for basic or larger versions */ -#define COMPLEX 1 -#define SPARSE 1 - -/* for loop unrolling */ -/* #undef VUNROLL */ -/* #undef MUNROLL */ - -/* for segmented memory */ -#ifndef NOT_SEGMENTED -#define SEGMENTED -#endif - -/* if the system has malloc.h */ -#ifdef HAVE_MALLOC_H -#define MALLOCDECL 1 -#include <malloc.h> -#endif - -/* any compiler should have this header */ -/* if not, change it */ -#include <stdio.h> - - -/* Check for ANSI C memmove and memset */ -#ifdef STDC_HEADERS - -/* standard copy & zero functions */ -#define MEM_COPY(from,to,size) memmove((to),(from),(size)) -#define MEM_ZERO(where,size) memset((where),'\0',(size)) - -#ifndef ANSI_C -#define ANSI_C 1 -#endif - -#endif - -/* standard headers */ -#ifdef ANSI_C -#include <stdlib.h> -#include <stddef.h> -#include <string.h> -#include <float.h> -#endif - - -/* if have bcopy & bzero and no alternatives yet known, use them */ -#ifdef HAVE_BCOPY -#ifndef MEM_COPY -/* nonstandard copy function */ -#define MEM_COPY(from,to,size) bcopy((char *)(from),(char *)(to),(int)(size)) -#endif -#endif - -#ifdef HAVE_BZERO -#ifndef MEM_ZERO -/* nonstandard zero function */ -#define MEM_ZERO(where,size) bzero((char *)(where),(int)(size)) -#endif -#endif - -/* if the system has complex.h */ -#ifdef HAVE_COMPLEX_H -#include <complex.h> -#endif - -/* If prototypes are available & ANSI_C not yet defined, then define it, - but don't include any header files as the proper ANSI C headers - aren't here */ -#define HAVE_PROTOTYPES 1 -#ifdef HAVE_PROTOTYPES -#ifndef ANSI_C -#define ANSI_C 1 -#endif -#endif - -/* floating point precision */ - -/* you can choose single, double or long double (if available) precision */ - -#define FLOAT 1 -#define DOUBLE 2 -#define LONG_DOUBLE 3 - -/* #undef REAL_FLT */ -/* #undef REAL_DBL */ - -/* if nothing is defined, choose double precision */ -#ifndef REAL_DBL -#ifndef REAL_FLT -#define REAL_DBL 1 -#endif -#endif - -/* single precision */ -#ifdef REAL_FLT -#define Real float -#define LongReal float -#define REAL FLOAT -#define LONGREAL FLOAT -#endif - -/* double precision */ -#ifdef REAL_DBL -#define Real double -#define LongReal double -#define REAL DOUBLE -#define LONGREAL DOUBLE -#endif - - -/* machine epsilon or unit roundoff error */ -/* This is correct on most IEEE Real precision systems */ -#ifdef DBL_EPSILON -#if REAL == DOUBLE -#define MACHEPS DBL_EPSILON -#elif REAL == FLOAT -#define MACHEPS FLT_EPSILON -#elif REAL == LONGDOUBLE -#define MACHEPS LDBL_EPSILON -#endif -#endif - -#define F_MACHEPS 1.19209e-07 -#define D_MACHEPS 2.22045e-16 - -#ifndef MACHEPS -#if REAL == DOUBLE -#define MACHEPS D_MACHEPS -#elif REAL == FLOAT -#define MACHEPS F_MACHEPS -#elif REAL == LONGDOUBLE -#define MACHEPS D_MACHEPS -#endif -#endif - -/* #undef M_MACHEPS */ - -/******************** -#ifdef DBL_EPSILON -#define MACHEPS DBL_EPSILON -#endif -#ifdef M_MACHEPS -#ifndef MACHEPS -#define MACHEPS M_MACHEPS -#endif -#endif -********************/ - -#define M_MAX_INT 2147483647 -#ifdef M_MAX_INT -#ifndef MAX_RAND -#define MAX_RAND ((double)(M_MAX_INT)) -#endif -#endif - -/* for non-ANSI systems */ -#ifndef HUGE_VAL -#define HUGE_VAL HUGE -#endif - - -#ifdef ANSI_C -extern int isatty(int); -#endif - //GO.SYSIN DD MACHINES/Linux/machine.h